Removing duplicates from an array

[plenderj]

How to remove duplicated items in an array.
This is (in my opinion) a very fast way of doing it.

I don't know of any faster methods.
If you need to remove duplicated items from an array of a different type, then just adjust the code accordingly.

Note: You will need to add a reference to "Microsoft Scripting Runtime" as the code uses its Dictionary object.
To do this, select Project from the toolbar, then select "References", and then select "Microsoft Scripting Runtime"

Option Explicit

Private Sub removeDuplicates(ByRef arrName() As Long)
    Dim i As Long, tempArr() As Long: ReDim tempArr(UBound(arrName))
    Dim d As New Dictionary, n As Long
    For i = 0 To UBound(arrName)
        If Not d.Exists(arrName(i)) Then
            d.Add arrName(i), arrName(i)
            tempArr(n) = arrName(i): n = n + 1
        End If
    Next
    ReDim Preserve tempArr(n)
    arrName = tempArr
End Sub

Private Sub Form_Load()
    Dim x() As Long, i As Long: ReDim x(99)
    
    '' this loop will fill the array with values :
    '' 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3...
    ''
    For i = 0 To 99
        x(i) = i Mod 4
    Next
    
    '' now remove the duplicated items
    ''
    removeDuplicates x
    
    '' now display whats left
    For i = 0 To UBound(x) - 1
        Debug.Print i & ":" & x(i)
    Next
End Sub 

[plenderj]

I still believe this to be the fastest method of removing duplicated items available in Classic VB.

[plenderj]

* 21-October-2004 - Moved to CodeBank *

[alawra]

how to use it in text please

[plenderj]

Just modify the code above to filter out Strings instead of Longs.

[Merri]

Originally Posted by plenderj

I still believe this to be the fastest method of removing duplicated items available in Classic VB.

You don't need to believe anymore: it isn't


This one is faster with strings by 10 - 20%

Public Sub strArrRemoveDuplicate(ByRef StringArray() As String)
    Dim LowBound As Long, UpBound As Long
    Dim TempArray() As String, Cur As Long
    Dim A As Long, B As Long
    
    'check for empty array
    If (Not StringArray) = True Then Exit Sub
    
    'we need these often
    LowBound = LBound(StringArray)
    UpBound = UBound(StringArray)
    
    'reserve check buffer
    ReDim TempArray(LowBound To UpBound)
    
    'set first item
    Cur = LowBound
    TempArray(Cur) = StringArray(LowBound)
    


    'loop through all items
    For A = LowBound + 1 To UpBound
        'make a comparison against all items
        For B = LowBound To Cur
            'if is a duplicate, exit array
            If LenB(TempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), TempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        'check if the loop was exited: add new item to check buffer if not
        If B > Cur Then Cur = B: TempArray(Cur) = StringArray(A)
    Next A
    
    'fix size
    ReDim Preserve TempArray(LowBound To Cur)
    'copy
    StringArray = TempArray
End Sub 

This works for Byte, Integer and Long datatypes and is four to five times faster:

Public Sub bArrRemoveDuplicate(ByRef ByteArray() As Byte)
    Dim LowBound As Long, UpBound As Long
    Dim TempArray() As Byte, TempByte As Byte, Cur As Long
    Dim A As Long, B As Long
    
    'check for empty array
    If (Not ByteArray) = True Then Exit Sub
    
    'we need these often
    LowBound = LBound(ByteArray)
    UpBound = UBound(ByteArray)
    
    'reserve check buffer
    ReDim TempArray(LowBound To UpBound)
    
    'set first item
    Cur = LowBound
    TempArray(Cur) = ByteArray(LowBound)
    
    'loop through all items
    For A = LowBound + 1 To UpBound
        TempByte = ByteArray(A)
        'make a comparison against all items
        For B = LowBound To Cur
            'if is a duplicate, exit array
            If (TempArray(B) Xor TempByte) = 0 Then Exit For
        Next B
        'check if the loop was exited: add new item to check buffer if not
        If B > Cur Then Cur = B: TempArray(Cur) = ByteArray(A)
    Next A
    
    'fix size
    ReDim Preserve TempArray(LowBound To Cur)
    'copy
    ByteArray = TempArray
End Sub 

To convert it to use Long for example, just use VB's inbuilt replace from the edit menu and make it convert Byte to Long. And rename the function, of course


What is the best thing with these functions: you don't need to add any extra reference to your project!

[plenderj]

Can you post the code you used to compare the times, because in the brief test I did my code still worked faster...

[Maven]

http://vbforums.com/attachment.php?attachmentid=33047

[plenderj]

Ah I take it you're comparing my code to your ASM code?

[Maven]

Originally Posted by plenderj

Ah I take it you're comparing my code to your ASM code?

Na, he was comparing my asm code, you're code, with his code.

[oli12345]

How about this compared to your methods? How are you comparing the speeds?

Function removeDuplicates(ByVal initialArray As String()) As String()
Dim i As Integer = 0
Dim j As Integer = 0
Dim newArray(0) As String

For i = 0 To UBound(initialArray)
For j = 0 To UBound(initialArray)
If Not initialArray(i) = "" Then
If Not j = i Then
If initialArray(i) = initialArray(j) Then
initialArray(j) = ""
End If
End If
End If
Next
Next

j = 0
For i = 0 To UBound(initialArray)
If Not initialArray(i) = "" Then
ReDim Preserve newArray(j)
newArray(j) = initialArray(i)
j = j + 1
End If
Next

Return newArray

End Function