or maybe
Option Explicit
Sub ptest()
    Dim p!, i!, k(), e
    With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 1)
        e = .Value
    End With
    ReDim k(1 To UBound(e, 1), 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(e, 1)
            If Not IsEmpty(e(i, 1)) Then
                If Not .exists(e(i, 1)) Then
                    p = p + 1
                  k(p, 0) = e(i, 1)
                  .Add e(i, 1), p
                  End If
         End If
        Next
       With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 1)
        .ClearContents
    End With
       End With
    Range("a1").Resize(p, 1).Value = k
 End Sub