Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4,VB5,VB6
Expertise: Intermediate
Nov 20, 1999



Building the Right Environment to Support AI, Machine Learning and Deep Learning

FilterDuplicates - Delete duplicate items in an array

' 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
        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
    ' return the number of duplicates
    FilterDuplicates = dups
End Function
Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date