Apply validation on a textbox using vba

[aman]

Hi guys

I have to put a validation in a Policy number textbox so that it can accept in total 8 characters and meets the following conditions.
1. First 7 characters are digits(0 to 9)
2. Last character is any Alphabet(a-Z)
3. Multiple first digit by 2, the second by 4,third by 8,fourth by 5,fifth by 10,sixth by 9 and seventh by 7.
Add these all together & divide by 11. The last (8th character) is based on the remainder.

if remainder =0 then
it can be 'A','C' OR 'X'
elseif remainder =1 then
it can be 'B','E' OR 'A'
elseif remainder =2 then
it can be 'D','G' OR 'C'
elseif remainder =3 then
it can be 'F','J' OR 'E'
elseif remainder =4 then
it can be 'H','L' OR 'F'
elseif remainder =5 then
it can be 'K','M' OR 'J'
elseif remainder =6 then
it can be 'N','Q' OR 'L'
elseif remainder =7 then
it can be 'P','R' OR 'M'
elseif remainder =8 then
it can be 'T','S' OR 'R'
elseif remainder =9 then
it can be 'U','W' OR 'T'
elseif remainder =10 then
it can be 'X','Y' OR 'W'

Anything else isn't a valid policy number.I hope anyone can help me to do it.

Thanks

 

[mdlueck]

It looks like you have a pretty clear prototype of the code needed already. What further questions do you have? Are you not familiar with coding in Access VBA?

 

[aman]

Hi

I am writing the following code:

Private Sub CommandButton2_Click()
     Call abc
            
End Sub
Function abc()
Dim vecWeights() As Variant
Dim lastChar As String
Dim total As Long
Dim remain As Long
Dim i As Long
    vecWeights = Array(2, 4, 8, 5, 10, 9, 7)
    With Me.TextBox8
    
        If Len(.Text) <> 8 Then
        
            MsgBox "Invalid length"
        ElseIf Not IsNumeric(Left$(.Text, 7)) Then
        
            MsgBox "First 7 characters must be numeric"
        Else
        
            For i = 1 To 7
            
                total = total + Left$(.Text, i) * vecWeights(i - 1)
            Next i
            
            remain = total Mod 11
            lastChar = Right$(.Text, 1)
            Select Case True
            
                Case remain = 0 And (lastChar = "A" Or lastChar = "C" Or lastChar = "X"):
                Case remain = 1 And (lastChar = "B" Or lastChar = "E" Or lastChar = "A"):
                Case remain = 2 And (lastChar = "D" Or lastChar = "G" Or lastChar = "C"):
                Case remain = 3 And (lastChar = "F" Or lastChar = "J" Or lastChar = "E"):
                Case remain = 4 And (lastChar = "H" Or lastChar = "L" Or lastChar = "F"):
                Case remain = 5 And (lastChar = "K" Or lastChar = "M" Or lastChar = "J"):
                Case remain = 6 And (lastChar = "N" Or lastChar = "Q" Or lastChar = "L"):
                Case remain = 7 And (lastChar = "P" Or lastChar = "R" Or lastChar = "M"):
                Case remain = 8 And (lastChar = "T" Or lastChar = "S" Or lastChar = "R"):
                Case remain = 9 And (lastChar = "U" Or lastChar = "W" Or lastChar = "T"):
                Case remain = 10 And (lastChar = "X" Or lastChar = "Y" Or lastChar = "W"):
                Case Else: MsgBox "Invalid check character"
            End Select
        End If
    End With
End Function

Now I want to adjest the following code so that when the person has typed the right policy number then it should do the following thing otherwise display the error message and move the focus back to the textbox.

Frame2.Visible = False
            With Frame4
                .Visible = True
                .Top = 18
                .Left = 12
            End With
            TextBox9.SetFocus
            CommandButton3.Enabled = False

 

[mdlueck]

Now I want to adjest the following code so that when the person has typed the right policy number...

Sounds like one bit of code I have which supports a find-as-you-type style interface, and the UI field turns red when the find fails. Also it has a Find Next button involved, that will find the next occurrence of the same search string... such as searching for "Smith" and stepping through each hit. Once the field turns red, then calls to the FindNext method no longer happen.

Private Sub fldFind_Change()
  On Error GoTo Err_fldFind_Change

  Dim strFindText As String

  'Find out if the Search Field has a value in it, else we outtahere!
  strFindText = Nz(Me.fldFind.Text, "")
  If strFindText = "" Then
    Me.fldFind.BackColor = vbWhite
    GoTo Exit_fldFind_Change
  End If

  Call FindRecord(strFindText, False)

Exit_fldFind_Change:
  Exit Sub

Err_fldFind_Change:
  Call errorhandler_MsgBox("Form: Form_parts, Subroutine: fldFind_Change()")
  Resume Exit_fldFind_Change

End Sub

Private Sub btnFindNext_Click()
  On Error GoTo Err_btnFindNext_Click

  Dim strFindText As String

  'Find out if the Search Field has a value in it, else we outtahere!
  strFindText = Nz(Me.fldFind.Value, "")
  If strFindText = "" Then
    Me.fldFind.BackColor = vbWhite
    GoTo Exit_btnFindNext_Click
  End If

  Call FindRecord(strFindText, True)

Exit_btnFindNext_Click:
  Exit Sub

Err_btnFindNext_Click:
  Call errorhandler_MsgBox("Form: Form_parts, Subroutine: btnFindNext_Click()")
  Resume Exit_btnFindNext_Click

End Sub

Private Sub FindRecord(ByVal strFindText As String, ByVal flgFindNext As Boolean)
  On Error GoTo Err_FindRecord

  Dim strFindInCol
  Dim strWhereClause
  Dim daoRS As DAO.Recordset

  'Find out which column is currently being sorted by
  If InStr(strCurrentSort, " ") = 0 Then
    strFindInCol = strCurrentSort
  Else
    strFindInCol = Mid(strCurrentSort, 1, InStr(strCurrentSort, " ") - 1)
  End If

  'Determine if the col is one we support string matches for
  'If not, then exit
  If Not (strFindInCol = "partnumber") And _
     Not (strFindInCol = "title") Then
     'Blank the search field
     Me.fldFind.Value = ""
     'Debug.Print "Wrong Col: " & strFindInCol
     GoTo Exit_FindRecord
  End If

  'Atttach to the Form's record set
  Set daoRS = Me.RecordsetClone
  strWhereClause = "[" & strFindInCol & "] LIKE " & Chr(34) & "*" & strFindText & "*" & Chr(34)
  If flgFindNext = True Then
    daoRS.FindNext (strWhereClause)
  Else
    daoRS.FindFirst (strWhereClause)
  End If
  'If we could find no match
  If daoRS.NoMatch Then
    Me.fldFind.BackColor = vbRed
    'Debug.Print "NoMatch"
  'Else jump to it
  Else
    Me.Bookmark = daoRS.Bookmark
    With Me.fldFind
      .BackColor = vbWhite
      .SetFocus
      .SelStart = Len(strFindText)
    End With
    'Debug.Print "Match"
  End If

Exit_FindRecord:
  Exit Sub

Err_FindRecord:
  Call errorhandler_MsgBox("Form: Form_parts, Subroutine: FindRecord()")
  Resume Exit_FindRecord

End Sub