View Full Version : [SOLVED] VBA Row (Couinter) Assigning Problem

12-14-2015, 01:49 AM
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:


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,....

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

12-14-2015, 02:39 AM
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)
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
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?