I think that something like this would help with the unique values:
Sub UniqueValues()
Dim tmp As String
Dim arr() As String
Dim cell As Range
Dim arraycount As Integer
If Not Selection Is Nothing Then
tmp = "|"
For Each cell In Selection
If (cell <> "") And (InStr(tmp, "|" & cell & "|") = 0) Then
tmp = tmp & cell & "|"
End If
Next cell
End If
If Len(tmp) > 0 Then
tmp = Right(Left(tmp, Len(tmp) - 1), Len(tmp) - 2)
arr = Split(tmp, "|")
End If
For arraycount = 0 To UBound(arr)
' Sheets("Categories").Range("J8").Cells(arraycount + 1, 1).Value = arr(arraycount)
Debug.Print arraycount & ". " & arr(arraycount)
Next arraycount
End Sub