Help Simple List build

Roderick_E

Well-known Member
Joined
Oct 13, 2007
Messages
2,051
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
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Roderick_E

Well-known Member
Joined
Oct 13, 2007
Messages
2,051
FOUND MY CODE...

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

MrExcel MVP
Joined
Dec 16, 2013
Messages
2,857
Code:
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

Well-known Member
Joined
Oct 13, 2007
Messages
2,051
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,325
Messages
5,547,263
Members
410,783
Latest member
sonnny
Top