Extract Unique List That Meets Criteria

[swaggerbox]

In column B, I have list of item numbers. I need to check if these item numbers have the value "12334". If it finds a match, extract its corresponding B value. However, column B items have duplicates. I only need the unique items.
In the example below, three rows meet the criteria (=12334), but I only need red and yellow (unique items). Take note the last row is also red. Output is on the last row of Sheet2

Sheet1
ColumnA ColumnB
red 12334
yellow 12334
blue 23455
red 12334

Sheet2
ColumnA
red
yellow

[mancubus]

Sub vbax_64186_unique_list_from_filtered_rows()

    Dim dict, itm
    Dim cll as Range
    
    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")
        .AutoFilterMode = False
        .Cells(1).AutoFilter 2, 12334
        With .AutoFilter.Range
            For Each cll In .Columns(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 'exclude header row
            'For Each cll In .Columns(1).SpecialCells(xlCellTypeVisible) 'include header row
                itm = dict.Item(cll.Value)
            Next
        End With
        .AutoFilterMode = False
    End With

    With Worksheets("Sheet2")
         .Cells(1).CurrentRegion.ClearContents 'clear existing data, if any
         .Cells(1).Resize(dict.Count) = Application.Transpose(dict.Keys)
    End With

End Sub

[大灰狼1976]

Private Sub test()
Dim arr, i&, dic As Object, r&
Set dic = CreateObject("scripting.dictionary")
arr = Sheets(1).[a1].CurrentRegion
For i = 1 To UBound(arr)
  If arr(i, 2) = 12334 Then dic(arr(i, 1)) = ""
Next i
With Sheets(2)
  If .Cells(1, 1) = "" Then r = 1 Else r = .[a65536].End(3).Row + 1
  .Cells(r, 1).Resize(dic.Count) = Application.Transpose(dic.keys)
End With
End Sub

[mana]

Sub test()
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
    
    ws1.Rows(1).Resize(2).Insert
    ws1.Range("A1:B1").Value = Array("T1", "T2")    'Dummy
    ws1.Range("Z2").Formula = "=B2=12334"           'Criteria
    
    ws1.Columns("A:B").AdvancedFilter xlFilterCopy, ws1.Range("Z1:Z2"), ws2.Range("A1"), True
    
    ws1.Rows("1:2").Delete
    ws2.Rows(1).Delete
    ws2.Columns(2).Delete
    
End Sub