Find and return corresponding first matching value found + transpose data

You have wrong results due to the strange transposed data from UniqueItem

Sub test()
    Dim a, i As Long, ii As Long, iii As Long, rc As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets("cards").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
        dic(a(i, 1))(a(i, 2)) = Empty
    Next
    Sheets("output").UsedRange.Clear
    With Sheets("uniqueitem").[a2].CurrentRegion.Offset(1)
        .Columns("b:d").Copy
        Sheets("output").Cells(1).PasteSpecial Transpose:=True
        .Columns(1).Copy
        Sheets("output").[a4].PasteSpecial Transpose:=True
    End With
    With Sheets("output").Cells(1).CurrentRegion
        rc = .Rows.Count
        a = .Resize(rc + dic.Count).Value
        For i = 0 To dic.Count - 1
            a(rc + i + 1, 1) = dic.keys()(i)
            For ii = 2 To UBound(a, 2)
                For iii = 1 To 3
                    If dic.items()(i).exists(a(iii, ii)) Then
                        a(rc + i + 1, ii) = a(iii, ii): Exit For
                    End If
                Next
            Next
        Next
        With .Resize(rc + dic.Count)
            .Value = a: .Columns.AutoFit
            On Error Resume Next
            .SpecialCells(4).Interior.Color = vbRed
            On Error GoTo 0
            .Cells(1).Select
        End With
    End With
End Sub

.

@jindon - thank you so much! Code works great!

You are welcome and thanks for the rep.