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

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,218,945
Messages
6,145,359
Members
450,611
Latest member
JodiWe

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
Back
Top