Lookup Data in One Column, Find Multiple Entries in Next, Copy to Multiple Columns

Hi nzxt1234,
Welcome to the forum.
Its hard to follow what is what with the supplied examples.

maybe something like

Sub testv()
    Dim a, b(), i As Long, n As Long, temp As String, e
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2)
        a = .Value
 
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 2 To UBound(a, 1)
              
            If Not .exists(a(i, 1)) Then
              n = n + 1
                b(n, 1) = a(i, 1)
                .Add a(i, 1), n
            End If
               b(.Item(a(i, 1)), 2) = b(.Item(a(i, 1)), 2) & IIf(b(.Item(a(i, 1)), 2) <> "", ",", "") & a(i, 2)
        Next
        .RemoveAll
        For i = 1 To n
            t = 1
            For Each e In Split(b(i, 2), ",")
                If Not .exists(e) Then
                    temp = temp & "," & e
                    .Add e, Nothing
                End If
            Next
            b(i, 2) = Mid$(temp, 2)
            temp = ""
            .RemoveAll
        Next
       End With
    End With
    Range("F2").Resize(n, 2).Value = b
End Sub

or even

Sub testv()
    Dim a, b(), i As Long, n As Long, temp As String, e
    With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 2)
        a = .Value
 End With
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 2 To UBound(a, 1)
              
            If Not .exists(a(i, 1)) Then
              n = n + 1
                b(n, 1) = a(i, 1)
                .Add a(i, 1), n
            End If
               b(.Item(a(i, 1)), 2) = b(.Item(a(i, 1)), 2) & IIf(b(.Item(a(i, 1)), 2) <> "", ",", "") & a(i, 2)
  
        Next
        .RemoveAll
     With Range("a2")
        .CurrentRegion.ClearContents
    End With
        For i = 1 To n
     Cells(i + 1, 1) = b(i, 1)
     t = 2
            For Each e In Split(b(i + 1, 2), ",")
            
                If Not .exists(e) Then
                     Cells(i + 1, t) = e
                    t = t + 1
                    .Add e, Nothing
                End If
            Next
             temp = ""
            .RemoveAll
        Next
       End With