Validating entire delimited string in textbox entries

I am using the following code to validate a textbox entry.
The problem is that the code really only evaluates the comma delimited entries as they are entered. If a user goes farther back into the string and removes a comma or adds a digit the code doesn't catch it.
I'd like the code to be able to evaluate the entire string as well as the last entry.
Any help would be appreciated!

Sub Val_GTBox(f As UserForm)
    Dim X, I As Long, ii As Integer
     
    If f.GainTextBox = "" Then Exit Sub
    If Right(f.GainTextBox, 2) = ",," Then f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 1): Exit Sub
    If Right(f.GainTextBox, 1) <> "," Then
        If Not IsNumeric(Right(f.GainTextBox, 1)) Then
            MsgBox "Nonnumeric entry, please change", , "Invalid entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 1)
            Application.EnableEvents = False: Exit Sub
        End If
        On Error GoTo ErrHandler
        
        Select Case Range("a2")
        Case "1"
        If CInt(Right(f.GainTextBox, 3)) > 288 Then
            MsgBox "Please enter a value between 1 and 288", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 3)
            Exit Sub
        End If
        Case "2"
        If CInt(Right(f.GainTextBox, 3)) > 416 Then
            MsgBox "Please enter a value between 1 and 416", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 3)
            Exit Sub
        End If
        Case "3"
        If CInt(Right(f.GainTextBox, 3)) > 224 Then
            MsgBox "Please enter a value between 1 and 224", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 3)
            Exit Sub
        End If
        Case "4"
        If CInt(Right(f.GainTextBox, 2)) > 96 Then
            MsgBox "Please enter a value between 1 and 96", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 2)
            Exit Sub
        End If
        Case "5"
        If CInt(Right(f.GainTextBox, 2)) > 48 Then
            MsgBox "Please enter a value between 1 and 48", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 2)
            Exit Sub
        End If
        Case "6"
        If CInt(Right(f.GainTextBox, 2)) > 48 Then
            MsgBox "Please enter a value between 1 and 48", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 2)
            Exit Sub
        End If
        End Select
        
ErrHandler:
        On Error GoTo 0
    Else
        If Len(f.GainTextBox) = 1 Then f.GainTextBox = "": Exit Sub
        X = Split(f.GainTextBox, ",")
        
        If CInt(X(UBound(X) - 1)) = 0 Then
            MsgBox "Please enter a value of 1 or greater", , "Invalid Entry"
            f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 2)
            Exit Sub
        End If
        
        If UBound(X) <> 1 Then
            For I = 0 To UBound(X) - 2
                If X(UBound(X) - 1) = X(I) Then
                    MsgBox "Duplicate entry, please change", , "Invalid Entry"
                    f.GainTextBox = ""
                    For ii = 0 To UBound(X) - 2
                        If f.GainTextBox = "" Then
                            f.GainTextBox = X(ii) & ","
                        Else
                            f.GainTextBox = f.GainTextBox.Text & X(ii) & ","
                        End If
                    Next
                    Exit For
                End If
            Next
        End If
    End If
End Sub

Open in new window

jcgrooveAsked:
Who is Participating?
 
Martin LissOlder than dirtCommented:
See if this meets all your requirements.
Private Sub GainTextBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim strParts() As String
Dim lngIndex As Long
Dim strMsg As String
Dim colTest As New Collection
Dim strTemp As String

strParts = Split(GainTextBox.Text, ",")

' Check for leading commas
GainTextBox.Text = Trim(GainTextBox.Text)
If strParts(0) = "" Then
    strMsg = strMsg & "Leading comma(s), please remove" & vbCrLf
End If

' Check for trailing commas
If strParts(UBound(strParts)) = "" Then
    strMsg = strMsg & "Trailing comma(s), please remove" & vbCrLf
End If

' Check for two commas (or more) next to each other
strTemp = Replace(GainTextBox.Text, ",,", "")
If Len(strTemp) <> Len(GainTextBox.Text) Then
    strMsg = strMsg & "Two or more consecutive commas, please remove" & vbCrLf
End If

' If there's a duplicate number error 457 will be raised
For lngIndex = 0 To UBound(strParts)
    On Error Resume Next
    If strParts(lngIndex) <> "" Then
        colTest.Add strParts(lngIndex), strParts(lngIndex)
        If Err.Number = 457 Then
            strMsg = strMsg & "Duplicate entry, please change" & vbCrLf
            Exit For
        End If
    End If
Next

' Look for non-numerics
For lngIndex = 0 To UBound(strParts)
    If strParts(lngIndex) <> "" Then
        If Not IsNumeric(strParts(lngIndex)) Then
            strMsg = strMsg & "Nonnumeric entry '" & strParts(lngIndex) & "', please change" & vbCrLf
            Exit For
        End If
    End If
Next

For lngIndex = 0 To UBound(strParts)
    If IsNumeric(strParts(lngIndex)) Then
        Select Case Range("a2")
        Case "1"
        If Val(strParts(lngIndex)) > 288 Or Val(strParts(lngIndex)) < 1 Then
            strMsg = strMsg & strParts(lngIndex) & " is too large. Please enter a value between 1 and 288" & vbCrLf
        End If
        Case "2"
        If Val(strParts(lngIndex)) > 416 Or Val(strParts(lngIndex)) < 1 Then
            strMsg = strMsg & strParts(lngIndex) & " is too large. Please enter a value between 1 and 416" & vbCrLf
        End If
        Case "3"
        If Val(strParts(lngIndex)) > 224 Or Val(strParts(lngIndex)) < 1 Then
            strMsg = strMsg & strParts(lngIndex) & " is too large. Please enter a value between 1 and 224" & vbCrLf
        End If
        Case "4"
        If Val(strParts(lngIndex)) > 96 Or Val(strParts(lngIndex)) < 1 Then
            strMsg = strMsg & strParts(lngIndex) & " is too large. Please enter a value between 1 and 96" & vbCrLf
        End If
        Case "5", "6"
        If Val(strParts(lngIndex)) > 48 Or Val(strParts(lngIndex)) < 1 Then
            strMsg = strMsg & strParts(lngIndex) & " is too large. Please enter a value between 1 and 48" & vbCrLf
        End If
        Case Else
            strMsg = strMsg & "Cell A2 must be a number from 1 to 6" & vbCrLf
        End Select
    End If
Next
If strMsg > "" Then
    Cancel = True
    MsgBox strMsg, , "Invalid Entry"
End If
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
When (from which event) do you try to validate the textbox? What is the valid format?
0
 
Martin LissOlder than dirtCommented:
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
jcgrooveAuthor Commented:
The code runs on the textbox change event.
Valid format is a one, two or three digit number separated by a comma with no spaces. No zeroes and a high limit of 48, 96, 224 or 416 depending on the case. (this is already built into the code above)
0
 
Martin LissOlder than dirtCommented:
You should validate it from the LostFocus event.
0
 
Martin LissOlder than dirtCommented:
Sorry, that was a Vb6 answer. Try the BeforeUpdate event.
0
 
jcgrooveAuthor Commented:
I tried the different events with no luck.
The code still only evaluates for minimum and maximum numbers after the last comma.
0
 
Martin LissOlder than dirtCommented:
Let me give it a closer look and I'll get back to you.
0
 
Martin LissOlder than dirtCommented:
Having the error routine in the middle if an If statement is very unusual. If you can please specify all the validation rules for me I'll try to rewrite the validation.
0
 
jcgrooveAuthor Commented:
-numbers only separated by commas with no spaces
-no duplicates
-no zero entries
- no entries greater than 48, 96, 224 or 416 (depending on the case)
-numbers can be up to three digits

That's all I can think of.

Thanks!
0
 
jcgrooveAuthor Commented:
Oh and no leading or trailing commas
0
 
Martin LissOlder than dirtCommented:
Comment out your call to your validation routine in the Change event and try this instead.

Private Sub GainTextBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim strParts() As String
Dim strTemp As String
Dim lngIndex As Long

strParts = Split(GainTextBox.Text, ",")
' Remove the commas for comparison purposes
strTemp = Replace(GainTextBox, ",", "")

If UBound(strParts) <> 2 Or Len(strTemp) + 2 <> Len(GainTextBox) Then
    MsgBox "There must be exactly three numbers separated by commas", , "Invalid Entry"
    Exit Sub
End If

If strParts(0) = strParts(1) Or _
   strParts(0) = strParts(2) Or _
   strParts(1) = strParts(2) Then
    MsgBox "Duplicate entry, please change", , "Invalid Entry"
    Exit Sub
End If

If Not IsNumeric(strParts(0)) Or _
   Not IsNumeric(strParts(1)) Or _
   Not IsNumeric(strParts(2)) Then
    MsgBox "Nonnumeric entry, please change", , "Invalid entry"
    Exit Sub
End If

For lngIndex = 0 To 2
    Select Case Range("a2")
    Case "1"
    If Val(strParts(lngIndex)) > 288 Or Val(strParts(lngIndex)) < 1 Then
        MsgBox "Please enter a value between 1 and 288", , "Invalid Entry"
        Exit Sub
    End If
    Case "2"
    If Val(strParts(lngIndex)) > 416 Or Val(strParts(lngIndex)) < 1 Then
        MsgBox "Please enter a value between 1 and 416", , "Invalid Entry"
        Exit Sub
    End If
    Case "3"
    If Val(strParts(lngIndex)) > 224 Or Val(strParts(lngIndex)) < 1 Then
        MsgBox "Please enter a value between 1 and 224", , "Invalid Entry"
        Exit Sub
    End If
    Case "4"
    If Val(strParts(lngIndex)) > 96 Or Val(strParts(lngIndex)) < 1 Then
        MsgBox "Please enter a value between 1 and 96", , "Invalid Entry"
        Exit Sub
    End If
    Case "5", "6"
    If Val(strParts(lngIndex)) > 48 Or Val(strParts(lngIndex)) < 1 Then
        MsgBox "Please enter a value between 1 and 48", , "Invalid Entry"
        Exit Sub
    End If
    Case Else
        MsgBox "Cell A2 must be a number from 1 to 6", , "Invalid Entry"
        Exit Sub
    End Select
Next

End Sub

Open in new window

0
 
jcgrooveAuthor Commented:
Your code doesn't seem to work on the beforeupdate event.
When i put it in the change event, it alerts the three digit message on every single entry and doesn't alert on anything else.
Test.xlsm
0
 
aikimarkCommented:

-numbers only separated by commas with no spaces
-no duplicates
-no zero entries
- no entries greater than 48, 96, 224 or 416 (depending on the case)
-numbers can be up to three digits
1. Your code allows a zero length string
2. Your code allows an entry that ends with ",,"
3. Your code expects the last entry to be three or two digits long (depending on A2).  Does that mean the user needs to have leading zeroes in their entries?
4. What are you trying to do with the following line?
If Len(f.GainTextBox) = 1 Then f.GainTextBox = "": Exit Sub

Open in new window

5. Your code is only validating the third (last) entry for the limiting values.
0
 
aikimarkCommented:
I created this simplified version of your code that first cleans up the data and then does a validation of all the items.  There are still some blocks of code that I do not understand.  I've left them in as a conversation starter.
Sub Val_GTBox(f As UserForm)
    Dim X, I As Long, ii As Integer
    
    Dim strTemp As String
    Dim vItem As Variant
    Dim vLimits As Variant
    Dim oRE As Object
    
    'clean it up
    strTemp = Trim(f.GainTextBox)
    Do Until InStr(strTemp, " ") = 0
        strTemp = Replace(strTemp, " ", vbNullString)
    Loop
    f.GainTextBox = strTemp

    If Len(strTemp) = 0 Then Exit Sub
    '============================================
    '???? what does this do ???
    If Right(strTemp, 2) = ",," Then
        f.GainTextBox = Left(f.GainTextBox, Len(f.GainTextBox) - 1)
        Exit Sub
    End If
    '============================================
    
    vLimits = Array(-1, 288, 416, 224, 96, 96, 48)
    X = Split(strTemp, ",")
    For Each vItem In X
        'validate numeric
        If IsNumeric(vItem) Then
        Else
            MsgBox "Nonnumeric entry (" & vItem & "), please change", , "Invalid entry"
            Application.EnableEvents = False
            Exit Sub
        End If
        'check range
        Select Case Val(vItem)
            Case 1 To vLimits(Range("A2"))
            Case Else
                MsgBox "(" & vItem & ") not in range" & vbCr & "Please enter a value between 1 and " & vLimits(Range("A2")), , "Invalid Entry - Out of Range"
                Exit Sub
        End Select
    Next
    
    'Check for duplicate values
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Pattern = "(\d+),.*?\1(?:,|$)"
    If oRE.test(strTemp) Then
        MsgBox "Duplicate number values in string, please change", , "Invalid Entry"
        f.GainTextBox = ""
        Exit Sub
    End If
End Sub

Open in new window

0
 
aikimarkCommented:
If anyone is interested in how I'm testing this, I used a technique from this article:
http://www.experts-exchange.com/A_8352-Simulating-VB-Controls-in-VBA-Code.html

The top part of my module looks like this:
Option Explicit

Type frm
    GainTextBox As String
End Type

Sub testit()
    Dim f As frm
    f.GainTextBox = "  1, 2,3"
    Val_GTBox f
    Debug.Print f.GainTextBox
End Sub

Sub Val_GTBox(f As frm)     'f As UserForm

Open in new window

Of course, I change the parameter of the Val_GTBox() routine before I post that code back here in EE.

In the testit() routine, I can change the Range("A2") value as well as the string to be evaluated and run several tests.

Note: The string clean-up code is documented in this recent article: http:A_17559.html
0
 
Martin LissOlder than dirtCommented:
Your code doesn't seem to work on the beforeupdate event.
The BeforeUpdate event occurs when another control or the userform is clicked. Try the attached modification of your workbook. Click the OK button after you enter something into the textbox.
Test.xlsm
0
 
jcgrooveAuthor Commented:
OK, perhaps I can provide some clarification.
The original code I posted works and meets my needs for evaluating entries as they are typed in.
What I'm looking for is a follow on code that will evaluate the entire string of user entered values.
I need it to evaluate for a zero by itself, a value that exceeds one of the case defined values, a double comma, and comma at the beginning and end of the string. Then highlight the errors for correction by the user.

Martin - I still can't get your code to meet my needs. I enter a few numerical values (separated by commas), some are duplicates, a zero, and a value that exceeds the case but it only alerts on the three digit value when I hit ok.

Aikimark - The conversation starter portion of the code evaluates for a double comma. I tried your version of the code and got an "expression too complex" error.

I appreciate all your efforts and fear that I may have not been clear enough. My apologies and many thanks!
0
 
Martin LissOlder than dirtCommented:
I don't know what you're doing differently from me because it seems to be working for me. If you like you can download a QuickTime movie from here of me doing some testing.
0
 
jcgrooveAuthor Commented:
Martin - I entered (1,2,3,4,5,2,0,500,10) and it alerted that three digit number alert. A value from one to one of the case specific values may be entered. It did not alert on the duplicate, the zero or the value greater than the case defined value (500).
0
 
aikimarkCommented:
@jcgroove

It would help us to know what strings would be accepted and rejected.  We now see that you can have many more than three numbers in an accepted string.  Can I safely assume that the string will not contain parentheses?

zero or greater
did you mean one or greater?

expression too complex
On what statement did that occur?
What was the string you fed into the routine?
0
 
Martin LissOlder than dirtCommented:
Martin - I entered (1,2,3,4,5,2,0,500,10) and it alerted that three digit number alert. A value from one to one of the case specific values may be entered. It did not alert on the duplicate, the zero or the value greater than the case defined value (500).
The code is designed to report one error at a time. Do you want them all at once?
0
 
Martin LissOlder than dirtCommented:
Here's updated code that shows them all at once.
Private Sub GainTextBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim strParts() As String
Dim strTemp As String
Dim lngIndex As Long
Dim strMsg As String

strParts = Split(GainTextBox.Text, ",")
' Remove the commas for comparison purposes
strTemp = Replace(GainTextBox, ",", "")

If UBound(strParts) <> 2 Or Len(strTemp) + 2 <> Len(GainTextBox) Then
    strMsg = "There must be exactly three numbers separated by commas" & vbCrLf
End If

If strParts(0) = strParts(1) Or _
   strParts(0) = strParts(2) Or _
   strParts(1) = strParts(2) Then
    strMsg = strMsg & "Duplicate entry, please change" & vbCrLf
End If

If Not IsNumeric(strParts(0)) Or _
   Not IsNumeric(strParts(1)) Or _
   Not IsNumeric(strParts(2)) Then
    strMsg = strMsg & "Nonnumeric entry, please change" & vbCrLf
End If

For lngIndex = 0 To UBound(strParts)
    Select Case Range("a2")
    Case "1"
    If Val(strParts(lngIndex)) > 288 Or Val(strParts(lngIndex)) < 1 Then
        strMsg = strMsg & "Please enter a value between 1 and 288" & vbCrLf
    End If
    Case "2"
    If Val(strParts(lngIndex)) > 416 Or Val(strParts(lngIndex)) < 1 Then
        strMsg = strMsg & "Please enter a value between 1 and 416" & vbCrLf
    End If
    Case "3"
    If Val(strParts(lngIndex)) > 224 Or Val(strParts(lngIndex)) < 1 Then
        strMsg = strMsg & "Please enter a value between 1 and 224" & vbCrLf
    End If
    Case "4"
    If Val(strParts(lngIndex)) > 96 Or Val(strParts(lngIndex)) < 1 Then
        strMsg = strMsg & "Please enter a value between 1 and 96" & vbCrLf
    End If
    Case "5", "6"
    If Val(strParts(lngIndex)) > 48 Or Val(strParts(lngIndex)) < 1 Then
        strMsg = strMsg & "Please enter a value between 1 and 48" & vbCrLf
    End If
    Case Else
        strMsg = strMsg & "Cell A2 must be a number from 1 to 6" & vbCrLf
    End Select
Next
If strMsg > "" Then
    Cancel = True
    MsgBox strMsg, , "Invalid Entry"
End If
End Sub

Open in new window


The result with your data is this.
screenshot
There are two "Please enter a value between 1 and 224" messages because in this code both zero and a too large number produce the same error.
0
 
jcgrooveAuthor Commented:
OK.
I could have a single string of comma delimited (no spaces) numerical values from zero all the way to the case defined maximum. (48,96,224. 288 or 416)

example: 1,2,3,4,5,6,7,8,9,25,100,112,150,250,300

Validation criteria: no standalone zeroes, no duplicates, no values greater than case defined maximum, no double commas, no comma in front of the first value, no comma after the last value

The original code I posted does all this as the user enters the data into the textbox. However, if the user goes further back than the last delimited entry and removes a comma or adds a digit to a number to make it larger than the maximum, then the code doesn't catch it.

Martin - I don't mind if they're all at once as long as it tells the user which entries are in error.
0
 
Martin LissOlder than dirtCommented:
Earlier you said
Valid format is a one, two or three digit number
and I just realized that I misread that as saying that there were a maximum of 3 numbers allowed, rather than that each number can be a maximum of 3 digits. I'll change my code and get back to you.
0
 
aikimarkCommented:
Please reconcile these two constraints.
numerical values from zero
no standalone zeroes

The first allows a zero value and the second precludes a zero value.
0
 
aikimarkCommented:
I updated the regular expression pattern to better detect duplicates.  This still checks for values from 1 to the limit.  Change the Case statement if you want to allow zero values.
Sub Val_GTBox(f As UserForm)
    Dim X, I As Long, ii As Integer
    
    Dim strTemp As String
    Dim vItem As Variant
    Dim vLimits As Variant
    Dim oRE As Object
    Dim oMatches As Object
    
    'clean it up
    strTemp = Trim(f.GainTextBox)
    Do Until InStr(strTemp, " ") = 0
        strTemp = Replace(strTemp, " ", vbNullString)
    Loop
    f.GainTextBox = strTemp
    
    If Len(strTemp) = 0 Then Exit Sub
    
    vLimits = Array(-1, 288, 416, 224, 96, 96, 48)
    X = Split(strTemp, ",")
    For Each vItem In X
        'validate numeric
        If IsNumeric(vItem) Then
        Else
            MsgBox "Non-numeric entry (" & vItem & "), please change", , "Invalid entry - Not numeric value"
            Application.EnableEvents = False
            Exit Sub
        End If
        'check range
        Select Case Val(vItem)
            Case 1 To vLimits(Range("A2").Value)
            Case Else
                MsgBox "(" & vItem & ") not in range" & vbCr & "Please enter a value between 1 and " & vLimits(Range("A2").Value), , "Invalid Entry - Out of Range"
                Exit Sub
        End Select
    Next
    
    'Check for duplicate values
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Pattern = "(?:^|,)(\d+),.*?,\1(?:,|$)"
    If oRE.test(strTemp) Then
        Set oMatches = oRE.Execute(strTemp)
        MsgBox "Duplicate number (" & oMatches(0).submatches(0) & ") value in string, please change", , "Invalid Entry - Duplicate values"
        f.GainTextBox = vbNullString     'do you really want to empty the textbox?
        Exit Sub
    End If
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
In my code please change lines 27 to 37 to this.
' If there's a duplicate number error 457 will be raised
For lngIndex = 0 To UBound(strParts)
    On Error Resume Next
    If strParts(lngIndex) <> "" Then
        colTest.Add strParts(lngIndex), strParts(lngIndex)
        If Err.Number = 457 Then
            strMsg = strMsg & "Duplicate entry,'" & strParts(lngIndex) & "' please change" & vbCrLf
        End If
    End If
Next

Open in new window

0
 
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.