asked on

vba to compare data between commas for duplicates

I have a userform textbox that will only accept numerical values separated by a comma.
I need codes to compare the entries between the commas for duplicates and to evaluate for a minimum and maximum numerical entry. (as in no zeros and no numbers greater than 244).
I know I can launch it using the textbox change event, I just can't figure out the vba.

Simon

Please see this basic example. It could be improved, but demonstrates how to do the checks you require. It checks that values are numeric, integer, <244 and then checks for duplication against earlier elements.

UserFormExample.xlsm

See the code:

Option Base 0
Option Explicit

Private Sub TextBox1_Change()
Dim allUnique As Boolean
Dim allValidated As Boolean
Dim arr As Variant
Dim dupeArr() As String
Dim x As Integer, y As Integer
Dim validated As String

allUnique = True
allValidated = True

'Clear validation results textbox
Me.TextBox2.Value = Null

Debug.Print Me.TextBox1.Value
arr = Split(Me.TextBox1.Value, ",")
For x = LBound(arr) To UBound(arr)
    validated = validate(CStr(arr(x)))
    If validated <> "Pass" Then allValidated = False Else
    Me.TextBox2.Value = Me.TextBox2.Value & vbCrLf & arr(x) & vbTab & " Item Validation: " & validated
    
    'Check all but first element for duplication
    If x > LBound(arr) Then
        ReDim dupeArr(0)
        For y = LBound(arr) To x - 1
            If arr(y) = arr(x) Then
                allUnique = False
                If Not dupeArr(UBound(dupeArr)) = "" Then
                    ReDim Preserve dupeArr(UBound(dupeArr) + 1)
                End If
                dupeArr(UBound(dupeArr)) = y + 1
            End If
        Next y
        If dupeArr(LBound(dupeArr)) <> "" Then
            Me.TextBox2.Value = Me.TextBox2.Value & " - DUPLICATE of element" & IIf(UBound(dupeArr) > 0, "s ", " ") & Join(dupeArr, ",")
        End If
    End If
Next x

If allUnique And allValidated Then
Me.TextBox3.Value = "Pass"
Else
Me.TextBox3.Value = "Fail"
End If
End Sub


Function validate(strInput As String) As String
validate = "Pass"
If Not IsNumeric(strInput) Then
    validate = "Fail - not numeric"
ElseIf strInput <> Trim(strInput) Then
    validate = "Fail - contains spaces"
ElseIf Not strInput < 244 Then
    validate = "Fail >243"
ElseIf InStr(1, strInput, "0") > 0 Then
    validate = "Fail - contains zero"
ElseIf CInt(strInput) <> CDbl(strInput) Then
    validate = "Fail - not integer"
End If
End Function

Open in new window

jcgroove

ASKER

Thanks for the reply! I was able to get your code to work with very minor tweaking.
One question: how can we get the output to be failures only? There could be hundreds of inputs that pass validation and a handful that fail.

ASKER CERTIFIED SOLUTION

Simon

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

jcgroove

ASKER

After incorporating that last change, the duplicate check does not show the user input that was duplicated anymore.

Simon

Sorry, I was too quick with that edit.

Here's a revised version of the whole sub

Private Sub TextBox1_Change()
Dim allUnique As Boolean
Dim allValidated As Boolean
Dim arr As Variant
Dim dupeArr() As String
Dim x As Integer, y As Integer
Dim validated As String
Dim dupeMsg As String

allUnique = True
allValidated = True

'Clear validation results textbox
Me.TextBox2.Value = Null

Debug.Print Me.TextBox1.Value
arr = Split(Me.TextBox1.Value, ",")
For x = LBound(arr) To UBound(arr)
    dupeMsg = "" 'reset to empty string at start of each element check
    validated = validate(CStr(arr(x)))
    If validated <> "Pass" Then
        allValidated = False
        'Me.TextBox2.Value = Me.TextBox2.Value & vbCrLf & arr(x) & vbTab & " Item Validation: " & validated
    End If
    'Check all but first element for duplication
    If x > LBound(arr) Then
        ReDim dupeArr(0)
        For y = LBound(arr) To x - 1
            If arr(y) = arr(x) Then
                allUnique = False
                If Not dupeArr(UBound(dupeArr)) = "" Then 'only add new array element if initial element is not empty
                    ReDim Preserve dupeArr(UBound(dupeArr) + 1)
                End If
                dupeArr(UBound(dupeArr)) = y + 1
            End If
        Next y
        If dupeArr(LBound(dupeArr)) <> "" Then
            dupeMsg = " - DUPLICATE of element" & IIf(UBound(dupeArr) > 0, "s ", " ") & Join(dupeArr, ",")
        End If
    End If
    If validated <> "Pass" Or dupeMsg <> "" Then
        Me.TextBox2.Value = Me.TextBox2.Value & vbCrLf & arr(x) & vbTab & " Item Validation: " & validated
    End If
    If dupeMsg <> "" Then
        Me.TextBox2.Value = Me.TextBox2.Value & dupeMsg
    End If
Next x

If allUnique And allValidated Then
Me.TextBox3.Value = "Pass"
Else
Me.TextBox3.Value = "Fail"
End If
End Sub

Open in new window

jcgroove

ASKER

That got it! Thanks again!