Option Explicit
Sub example_RemoveDupsFromEaColOrRow()
Dim vntChoice As Variant
Dim bolChoice As Boolean
Dim aryVals() As Variant
'// Just for the example, I might use a simple userform. //
vntChoice = Application.InputBox( _
"Enter ""r"" or ""1"" to remove duplicates from the rows selected." & vbCrLf & _
"Enter ""c"" or ""2"" to remove duplicates from the columns selected.", _
"Choose Operation", Type:=1 Or 2 _
)
'// Check to see that a valid pick was made or bailout. //
If (vntChoice = vbNullString Or vntChoice = False) _
Or Not InStr(1, "rc12", CStr(vntChoice)) > 0 _
Or Selection.Cells.Count = 1 Then
MsgBox "Bad or no entry; or only one cell selected...", vbInformation, vbNullString
Exit Sub
End If
bolChoice = vntChoice = "c" Or vntChoice = 2
aryVals = Selection.Value
If RetUniques(aryVals, bolChoice) Then
Range("F2").Resize(UBound(aryVals, 1), UBound(aryVals, 2)).Value = aryVals
End If
End Sub
Function RetUniques(Vals() As Variant, Optional ByColumn As Boolean = False) As Boolean
Dim DIC As Object ' Dictionary
Dim aryTemp As Variant
Dim aryDicKeys As Variant
Dim n As Long
Dim x As Long
Dim y As Long
'// Size an output array to equal the size of range selected. I figure you will //
'// probably overwrite the range. //
ReDim aryTemp(1 To UBound(Vals, 1), 1 To UBound(Vals, 2))
Set DIC = CreateObject("Scripting.Dictionary")
If Not ByColumn Then
For x = 1 To UBound(Vals, 1)
If DIC.Count > 0 Then DIC.RemoveAll
For y = 1 To UBound(Vals, 2)
DIC.Item(Vals(x, y)) = Empty
Next
If DIC.Exists(vbNullString) Then DIC.Remove (vbNullString)
aryDicKeys = DIC.Keys
For n = 0 To DIC.Count - 1
aryTemp(x, n + 1) = aryDicKeys(n)
Next
Next
Else
For y = 1 To UBound(Vals, 2)
If DIC.Count > 0 Then DIC.RemoveAll
For x = 1 To UBound(Vals, 1)
DIC.Item(Vals(x, y)) = Empty
Next
If DIC.Exists(vbNullString) Then DIC.Remove (vbNullString)
aryDicKeys = DIC.Keys
For n = 0 To DIC.Count - 1
aryTemp(n + 1, y) = aryDicKeys(n)
Next
Next
End If
Vals = aryTemp
RetUniques = True
End Function
