FilterDup




Function FilterDuplicates(arr As Variant) As Long
Dim col As Collection, index As Long, dups As Long
Set col = New Collection

On Error Resume Next

For index = LBound(arr) To UBound(arr)
' build the key using the array element

' an error occurs if the key already exists

col.Add 0, CStr(arr(index))
If Err Then
' we've found a duplicate

arr(index) = Empty
dups = dups + 1
Err.Clear
ElseIf dups Then
' if we've found one or more duplicates so far

' we need to move elements towards lower indices

arr(index - dups) = arr(index)
arr(index) = Empty
End If
Next

' return the number of duplicates

FilterDuplicates = dups

End Function

Filter out duplicate values in an array and compact
the array by moving items to "fill the gaps".
Returns the number of duplicate values
it works with arrays of any type, except objects
The array is not REDIMed, but you can do it easily using

the following code:
a() is a string array
dups = FilterDuplicates(a())

If dups Then
ReDim Preserve a(LBound(a) To UBound(a) - dups) As String
End If










( filterdup.html )- by Paolo Puglisi - Modifica del 17/12/2023