Sub Uniques_From_Column()
    Dim lr As Long, i As Long
    Dim dic As Object
    Dim arr As Variant
    
With Sheets("Sheet1")
    lr = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    arr = .Range("B2:B" & lr)
End With

Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arr, 1)
  dic(arr(i, 1)) = 1
Next i

'write uniques to a column
Range("E2").Resize(dic.Count) = Application.Transpose(dic.keys)
' or
'do something with each unique
For i = 0 To dic.Count - 1
    'do what you want with each
    'this prints to the immediate window
    Debug.Print dic.keys()(i)
Next i

End Sub