Use Native Excel Function Lookup Formula In VBA

[bakerman]

or a collection

Sub bkrmn()
    Dim sq() As Variant
    
    sn = Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
    On Error Resume Next
    With New Collection
        For j = 1 To UBound(sn)
            If sn(j, 1) <> vbNullString Then .Add sn(j, 1), CStr(sn(j, 1))
        Next
        ReDim Preserve sq(.Count)
        For i = 1 To .Count
            sq(i - 1) = .Item(i)
        Next
    End With
    On Error GoTo 0
    With Sheets("Sheet1")
        .Columns(2).ClearContents
        .Range("B1").Resize(UBound(sq)) = Application.Transpose(sq)
    End With
End Sub