Extract unique items based on criteria

try something like this to run through names in column A

Sub GetData()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim x As Long
    x = 1
    
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Set Rng = sh.Range("A1", sh.Range("A1").End(xlDown))
    Set cUnique = New Collection
    
    On Error Resume Next
        For Each Cell In Rng.Cells
            If InStr(1, UCase(Cell.Value), "A", vbTextCompare) > 0 Then
            cUnique.Add Cell.Value, CStr(Cell.Value)
            End If
        Next Cell
    On Error GoTo 0
    
    For Each vNum In cUnique
        sh.Cells(x, 2).Value = vNum
        x = x + 1
    Next vNum
    
End Sub