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 support@extramiledata.com.
' 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