Gary,
I didn't test this on a huge list so I'm not sure how fast the subroutine
would be. I suspect you'll want to make a few changes in how the initial
range is identified and possibly where the results end up (and also add a
sort if desired). For the example, the initial range is whatever is
currently selected. The values in the selection are dumped at the end (but
formatting is retained) and then the list, less any items that appeared
multiple times in your initial list, gets entered in column A beginning at
A1.
'-------------------------------------------
Sub RetrieveUniqueVals()
Dim rngRaw As Range
Dim rngCell As Range
Dim vExclusions As Variant
Dim vFinals As Variant
Set rngRaw = Selection
Set dictRaw = CreateObject("Scripting.Dictionary")
Set dictExclude = CreateObject("Scripting.Dictionary")
For Each rngCell In rngRaw.Cells
If dictRaw.Exists(rngCell.Value) Then
dictExclude.Add rngCell.Value, rngCell.Value
Else
dictRaw.Add rngCell.Value, rngCell.Value
End If
Next rngCell
vExclusions = dictExclude.Keys
For i = 0 To dictExclude.Count - 1
If dictRaw.Exists(vExclusions(i)) Then
dictRaw.Remove vExclusions(i)
End If
Next i
rngRaw.ClearContents
vFinals = dictRaw.Keys
For i = 0 To dictRaw.Count - 1
Cells(i + 1, 1).Value = vFinals(i)
Next i
Set dictRaw = Nothing
Set dictExclude = Nothing
End Sub
'-------------------------------------------
Steve Yandl
