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
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,116
Messages
5,835,476
Members
430,358
Latest member
zzc1128

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top