Function UNIQUE(array_range As Variant, Optional by_col As Boolean = False, Optional exactly_once As Boolean = False) As Variant
Dim ArrayColumn As Long, ArrayRow As Long
Dim ArrayDimensionFoundValue As Long, MaximumDimension As Long
Dim dict As Object
Dim ConcatString As String
Dim key As Variant, SplitKeyArray As Variant
Dim OutputArray As Variant, TempArray As Variant
Set dict = CreateObject("Scripting.Dictionary")
If TypeName(array_range) = "Range" Then
array_range = array_range.value2
Else
On Error Resume Next
Do Until ArrayDimensionFoundValue = 999
MaximumDimension = MaximumDimension + 1
ArrayDimensionFoundValue = 999
ArrayDimensionFoundValue = UBound(array_range, MaximumDimension)
Loop
On Error GoTo 0
MaximumDimension = MaximumDimension - 1
End If
If MaximumDimension = 1 Then
ReDim TempArray(1 To 1, 1 To UBound(array_range))
For ArrayColumn = 1 To UBound(array_range)
TempArray(1, ArrayColumn) = array_range(ArrayColumn)
Next
array_range = TempArray
End If
If by_col = False Then
For ArrayRow = LBound(array_range, 1) To UBound(array_range, 1)
For ArrayColumn = LBound(array_range, 2) To UBound(array_range, 2)
If ConcatString <> vbNullString Then
ConcatString = ConcatString & Chr(2) & array_range(ArrayRow, ArrayColumn)
Else
ConcatString = array_range(ArrayRow, ArrayColumn)
End If
Next
If Not dict.exists(ConcatString) Then
dict.Add ConcatString, 1
Else
dict(ConcatString) = dict(ConcatString) + 1
End If
ConcatString = vbNullString
Next
ReDim OutputArray(1 To dict.Count, 1 To UBound(array_range, 2))
ArrayRow = 0
For Each key In dict.keys
If exactly_once = False Then
SplitKeyArray = Split(key, Chr(2))
ArrayRow = ArrayRow + 1
For ArrayColumn = 1 To UBound(SplitKeyArray) + 1
OutputArray(ArrayRow, ArrayColumn) = SplitKeyArray(ArrayColumn - 1)
Next
Else
If dict(key) = 1 Then
SplitKeyArray = Split(key, Chr(2))
ArrayRow = ArrayRow + 1
For ArrayColumn = 1 To UBound(SplitKeyArray) + 1
OutputArray(ArrayRow, ArrayColumn) = SplitKeyArray(ArrayColumn - 1)
Next
End If
End If
Next
Else
For ArrayColumn = LBound(array_range, 2) To UBound(array_range, 2)
For ArrayRow = LBound(array_range, 1) To UBound(array_range, 1)
If ConcatString <> vbNullString Then
ConcatString = ConcatString & Chr(2) & array_range(ArrayRow, ArrayColumn)
Else
ConcatString = array_range(ArrayRow, ArrayColumn)
End If
Next
If Not dict.exists(ConcatString) Then
dict.Add ConcatString, 1
Else
dict(ConcatString) = dict(ConcatString) + 1
End If
ConcatString = vbNullString
Next
ReDim OutputArray(1 To UBound(array_range, 1), 1 To dict.Count)
ArrayColumn = 0
For Each key In dict.keys
If exactly_once = False Then
SplitKeyArray = Split(key, Chr(2))
ArrayColumn = ArrayColumn + 1
For ArrayRow = 1 To UBound(SplitKeyArray) + 1
OutputArray(ArrayRow, ArrayColumn) = SplitKeyArray(ArrayRow - 1)
Next
Else
If dict(key) = 1 Then
SplitKeyArray = Split(key, Chr(2))
ArrayColumn = ArrayColumn + 1
For ArrayRow = 1 To UBound(SplitKeyArray) + 1
OutputArray(ArrayRow, ArrayColumn) = SplitKeyArray(ArrayRow - 1)
Next
End If
End If
Next
End If
UNIQUE = OutputArray
End Function