505.369.1650 [email protected]

This VBA function looks for duplicate values in an array.  If it finds some, it produces a list of the duplicated values.  It is a good example of how to loop through an array.

The argument needs to be an array.  Nulls in the array are ignored by the logic, and the result is a string of comma+space separated values.  One use of this function is to pass back a message to the user if they entered duplicate values in controls on a Microsoft Access form.

Here’s a simple example:
strResult = DuplicatesInArray(Array(“apple”, 3, “orange”, “pear”, Null, Null, “apple”, 4, 3))

In this case, strResult = “apple, 3”.  There is no sorting logic, so the results come in the order of how the duplicate values are found.

If you are starting with a delimited string of values, another way to create the array argument is to use the Split() function.

Code:

Public Function DuplicatesInArray(ArrayOfValues) As String
' This function checks to see if there are duplicate values in the
' ArrayOfValues argument, which is an array.  If there are, it returns
' an unsorted, comma+space separated list of the duplicated values.
' If there are no duplicates, it returns a blank string, "".  The
' function ignores Nulls.

' DuplicatesInArray() Version 1.0.0
' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected]
' Use (at your own risk) and modify freely as long as proper credit is given.

On Error GoTo Err_DuplicatesInArray

    Dim intUB As Integer
    Dim intElem As Integer
    Dim intLoop As Integer
    Dim intCount As Integer
    Dim varValue
    Dim varLoop
    Dim strResults As String
   
    ' Get the upper bound of the array.
    intUB = UBound(ArrayOfValues)
    ' Initialize the variable that holds the results.
    strResults = ""
   
    ' Loop through the array of values, examining each value.
    For intElem = 0 To intUB
        ' Initialize the count of occurrences.
        intCount = 0
        ' Get the value that we're working with.
        varValue = ArrayOfValues(intElem)
        ' If the value is not Null, then continue.  We're ignoring
        ' Null values.
        If Not IsNull(varValue) Then
            ' Now that we have the value that we are checking,
            ' loop through the array and compare the value with all
            ' the other values.
            For intLoop = 0 To intUB
                ' Get the next value in the array.
                varLoop = ArrayOfValues(intLoop)
                ' We are ignoring Nulls, but if it is not null, and
                ' it matches the value that we are checking for, then
                ' increment the counter.
                If Not IsNull(varLoop) Then
                    If varLoop = varValue Then
                        intCount = intCount + 1
                    End If
                End If
            Next intLoop
            ' We would expect a count of 1, the value itself.  If the
            ' count is greater than 1, then there is a duplicate.  If
            ' we have not already listed the duplicate, then add it
            ' to the results.
            If intCount > 1 Then
                If InStr(strResults, varValue & ", ") = 0 Then
                    strResults = strResults & varValue & ", "
                End If
            End If
        End If
    Next intElem

    ' If there were some duplicates, then strip off the last
    ' comma+space and pass back the results.  If there were no
    ' duplicates, then pass back a blank string.
    If Len(strResults) > 0 Then
        DuplicatesInArray = Left(strResults, Len(strResults) - 2)
    Else
        DuplicatesInArray = ""
    End If

Exit_DuplicatesInArray:
    On Error Resume Next
    Exit Function
   
Err_DuplicatesInArray:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "DuplicatesInArray()"
    DuplicatesInArray = ""
    Resume Exit_DuplicatesInArray
End Function

Download Code:

basDuplicatesInArray.zip

Making Microsoft Access Work

No matter what your MS Access needs are, Carl can provide live help to make sure you get the solution you need.