VBA Functions To Remove Duplicates From Array



Sub Arry_Testing()
Dim stateArr(603) As String
Dim i As Integer
For i = 2 To 605
    stateArr(i - 2) = Range("B" & i).Value
Next
Dim uniqArr() As Variant
'Test the function here
uniqArr = RemoveDuplicates(stateArr)
End Sub


'Function to remove duplicates
Function RemoveDuplicates(arr As Variant) As Variant
    Dim dict As Object
    Dim i As Long
    Dim key As Variant
    Dim uniqueArray() As Variant
    Dim index As Long
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Add array elements to the dictionary to remove duplicates
    For i = LBound(arr) To UBound(arr)
        key = arr(i)
        If Not dict.Exists(key) Then
            dict.Add key, Nothing
        End If
    Next i
    
    ' Transfer unique keys back to an array
    ReDim uniqueArray(0 To dict.Count - 1)
    index = 0
    For Each key In dict.Keys
        uniqueArray(index) = key
        index = index + 1
    Next key
    
    RemoveDuplicates = uniqueArray
End Function

 

No comments:

Post a Comment