VBA Row (Couinter) Assigning Problem

Hi Guys,


I have a small matching problem.


I have three columns "A" as well as "B". and its counter (number of the row assigned to the IDs.).
In the column "A" I have unique IDs, in the column "B" the same IDs which however can appear more often 17 times or not it all (Please see the attachment).




The counter and Column A:


Column
AAA
BBB
CCC
NNN


The counter and Column B:


Counter, Column B
1. AAA
2. AAA
3. BBB
4. NNN
5. AAA




I wanto to create odput where between the column "A" and the counter of the column "B" is a table with number of rows (counters) (size #number of vlaues in column A times 17) in which IDs in column A appear in Column B.


Column A, 1, 2....17
AAA, 1, 2, 5, 0,....
BBB, 3,0,....
CCC,0...
NNN,4,0....






If you could help me to develop the code I invite you for Wiener Schnitzel in Vienna and beer.

Option Explicit


Sub test()
Dim a, i As Long, w
With [b5].CurrentRegion
.Offset(1, 2).Resize(.Parent.Range("b" & Rows.Count) _
.End(xlUp).Row - .Row, .Columns.Count - 4).Value = 0
a = .Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a, 1)
If a(i, 2) <> "" Then .Item(a(i, 2)) = Array(.Count + 2, 2)
Next
For i = 2 To UBound(a, 1)
If .exists(a(i, UBound(a, 2))) Then
w = .Item(a(i, UBound(a, 2)))
w(1) = w(1) + 1
a(w(0), w(1)) = a(i, UBound(a, 2) - 1)
.Item(a(i, UBound(a, 2))) = w
End If
Next
End With
.Value = a
End With
End Sub




I have the code but it seems to be not working if the IDs in the column A are not unique. Could someone help me with it?