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
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