Help Simple List build

[Roderick_E]

Ok, some reason I can't remember this simple VBA code (Excel 2003-2010).

Suppose you have column A and B, 5 to 11.
In column C you want the cumulative result of matches to column A (result = column B elements)

COLA COLB
CN 5
US 6
CN 7
US 8
CN 9
UK 10
CN 11

In column C I want

COLC
5,7,9,11
6,8
5,7,9,11
6,8
5,7,9,11
10
5,7,9,11

As you can see, these are cooresponding with matching column A to colum A.

For X = 5 to 11
....
Next X

 

[Roderick_E]

FOUND MY CODE...

Option Compare Text 'ignore text case
Sub crosscheck()
'Display wait for a moment
Application.StatusBar = "****Please Wait*****  Macro processing"
'opitmize macro by disabling all processes that slow it down.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Sheet1.Range("C5:C11") = "" 'clear previous
[COLOR=#ff0000]For x = 5 To 11
Application.StatusBar = "Processing row: " & x & " [" & Format(x / 11, "Percent") & "]"
DoEvents
For y = 5 To 11
If Trim(Sheet1.Cells(x, "a")) = Trim(Sheet1.Cells(y, "a")) Then
Sheet1.Cells(x, "c") = Trim(Sheet1.Cells(x, "c")) & Trim(Sheet1.Cells(y, "b")) & ","
End If
Next y
Next x
[/COLOR]'Re-enable screenupdating (before END SUB)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.StatusBar = False
MsgBox "COMPLETED"
End Sub

 

[VBA Geek]

Sub List_BUILD()
Dim vArr As Variant, cntr As Long, dic As Object, aResults As Variant
vArr = Range("A1").CurrentRegion.Value
Set dic = CreateObject("scripting.dictionary")
For cntr = LBound(vArr) To UBound(vArr)
    With dic
        If Not .Exists(vArr(cntr, 1)) Then
            .Add vArr(cntr, 1), vArr(cntr, 2)
        Else
            .Item(vArr(cntr, 1)) = .Item(vArr(cntr, 1)) & "," & vArr(cntr, 2)
        End If
    End With
Next cntr
ReDim aResults(1 To UBound(vArr, 1), 1 To 1)
For cntr = LBound(vArr) To UBound(vArr)
    aResults(cntr, 1) = dic.Item(vArr(cntr, 1))
Next
Range("c1").Resize(UBound(aResults, 1)).Value = aResults
set dic = nothing
End Sub

 

[Roderick_E]

Thanks VBA Geek. Although I found the code I developed for this, I tested your suggestion too. Works just as well. I'll keep both handy.