Try this one then
Sub test()
    Dim a, e, n As Long, x As Long, s
    s = Timer
    Application.ScreenUpdating = False
    With Cells(1).CurrentRegion
        a = .Columns(1).Resize(.Rows.Count * 2, 1).Value
        x = .Rows.Count
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For Each e In a
                If e <> "" Then
                    If Not .exists(e) Then
                        n = n + 1: .Item(e) = Empty
                        a(x + n, 1) = e
                    End If
                End If
            Next
        End With
        With .Resize(x + n, .Columns.Count + 1)
            .Columns(.Columns.Count).Value = a
            .Sort .Cells(2, .Columns.Count), 1, Header:=xlNo
            .Columns(.Columns.Count).EntireColumn.Delete
        End With
    End With
    Application.ScreenUpdating = True
    MsgBox Timer - s
End Sub