Выборка уникальных значений из диапазона ячеек

Function UniqueValues(ByVal arr) As Collection
    ' функция получает в качестве параметра массив любой размерности
    ' возвращает коллекцию уникальных НЕПУСТЫХ значений
    Set UniqueValues = New Collection: On Error Resume Next
    For Each v In arr
        v = Trim(v): If Len(v) Then UniqueValues.Add CStr(v), CStr(v)
    Next v
End Function
 
 
Sub ПримерИспользования_UniqueValues()
    For Each v In UniqueValues([a3:b6500].Value)
        Debug.Print v
    Next
End Sub

Function UniqueValuesFormRange(ByVal ra As Range) As Collection
    ' функция получает в качестве параметра диапазон ячеек
    ' возвращает коллекцию уникальных НЕПУСТЫХ значений
    Set UniqueValuesFormRange = New Collection: On Error Resume Next
    Dim ar As Range
    For Each ar In ra.Areas
        For Each v In ar.Value
            v = Trim(v): If Len(v) Then UniqueValuesFormRange.Add CStr(v), CStr(v)
        Next v
    Next ar
End Function

Sub ПримерИспользования_UniqueValuesFormRange()
    For Each v In UniqueValuesFormRange(Selection)
        Debug.Print v
    Next
End Sub