Спасибо, я код увидел и как раз разбирался с ним. Но возможно я как-то не так его применяю, ибо в результате получаю просто список уникальных значений из столбца, но не выполняется условие по соответствию.  
 
Код здесь выложу, для удобства.  
 
Sub Get_Unique()  
Dim rValRng As Object  
Set rValRng = Intersect(Selection, Selection.Parent.UsedRange)  
With Application  
.EnableEvents = False  
.ScreenUpdating = False  
rValRng.Offset(, 1).ClearContents  
rValRng.Offset(, 1).Value = DictionaryUniq(rValRng)  
.EnableEvents = True  
.ScreenUpdating = True  
End With  
End Sub  
 
Function DictionaryUniq(rRng As Object)  
Dim x, Arr, y, i As Long, Rng As Range, t As Single  
Arr = Rng.Value  
If IsArray(Arr) Then  
With CreateObject("Scripting.Dictionary")  
.CompareMode = vbTextCompare  
ReDim y(1 To UBound(Arr), 1 To 1)  
For Each x In Arr  
If Len(x) > 0 Then  
If Not .Exists(x) Then  
.Add x, 0  
y(.Count, 1) = x  
End If  
End If  
Next  
End With  
End If  
DictionaryUniq = y  
End Function  
 
Выделяете нужный столбец и запускаете макрос Get_Unique. Все. Уникальные значения будут вставлены правее выделенного столбца