Sub Test_RemoveDupesDict()
Dim arr1() As Variant, arr2() As Variant
Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
arr1 = sh.Range("a1:q1").Value
arr2 = RemoveDupesDict(arr1, 1, 2)
sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
Dim arr, a As Integer, j As Long
' SOURCE: https://wellsr.com
Dim i As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
Select Case dk
Case 1
ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
For i = LBound(MyArray, 1) To UBound(MyArray, 1)
If Not .exists(MyArray(i, so)) Then
a = a + 1
For j = 1 To UBound(MyArray, 2)
arr(a, j) = MyArray(i, j)
Next j
.Item(MyArray(i, so)) = 1
End If
Next
Case 2
ReDim arr(1 To UBound(MyArray, 2), 1 To UBound(MyArray, 1))
For i = LBound(MyArray, 2) To UBound(MyArray, 2)
If Not .exists(MyArray(1, i)) Then
a = a + 1
arr(a, 1) = MyArray(1, i)
.Item(MyArray(1, i)) = 1
End If
Next
End Select
RemoveDupesDict = arr
End With
End Function
