Binaryworld - FilterDuplicates - Delete duplicate items in an array ... [ VB -> Arrays ]

' 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

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