dcsimg
Login | Register   
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


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

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


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
            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
Francesco Balena
 
Comment and Contribute

 

 

 

 

 


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

 

 

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