Get Comma Delimed ID's if Column B is Duplicate

[zmaniar]

Hello Guys. Need Help with a VBA

I have ID's in Column A and Name on Column B. I need to have Comma Seperated ID's if the name is same.
So in Column I I want it show "10, 120, 174, 410, 578, 600, 615, 625, 889"

10	APPLE​
120	APPLE​
174	APPLE​
410	APPLE​
578	APPLE​
600	APPLE​
615	APPLE​
625	APPLE​
889	APPLE​

 

[Alex Blakenburg]

Are you sure you need to do it in VBA ? It is pretty straight forward to do that in Power Query.
In VBA unless you can rely on your data being sorted you need to be using the Dictionary object.

Here is an < 9 mins video on how to do it in Power Query from "The Power User".

20211207 PQ Concatenate Grouped Rows.xlsm
	A	B	C	D	E	F	G	H	I	J
1	ID	Name							Name	IDs
2	10	APPLE							APPLE	10, 120, 174, 410, 578, 600, 615, 625, 889
3	120	APPLE							ORANGE	20, 40, 60, 80, 100, 120
4	174	APPLE
5	410	APPLE
6	578	APPLE
7	600	APPLE
8	615	APPLE
9	625	APPLE
10	889	APPLE
11	20	ORANGE
12	40	ORANGE
13	60	ORANGE
14	80	ORANGE
15	100	ORANGE
16	120	ORANGE
Sheet1

let
    Source = Excel.CurrentWorkbook(){[Name="tbl_ID"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"ID", Int64.Type}, {"Name", type text}}),
    #"Sorted Rows" = Table.Sort(#"Changed Type",{{"Name", Order.Ascending}, {"ID", Order.Ascending}}),
    #"Grouped Rows" = Table.Group(#"Sorted Rows", {"Name"}, {{"ID Items", each _, type table [ID=nullable number, Name=nullable text]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "IDs", each Table.Column([ID Items],"ID")),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"ID Items"}),
    #"Extracted Values" = Table.TransformColumns(#"Removed Columns", {"IDs", each Text.Combine(List.Transform(_, Text.From), ", "), type text})
in
    #"Extracted Values"

 

[mohadin]

Hi
Try this code

Sub test()
    a = Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 2)) Then
                .Add a(i, 2), a(i, 1)
            Else
                .Item(a(i, 2)) = .Item(a(i, 2)) & "," & a(i, 1)
            End If
        Next
        Cells(1, 3).Resize(.Count, 2) = Application.Index(Application.Transpose(Array(.keys, .items)), 0, 0)
    End With
End Sub

 

[zmaniar]

Hi
Try this code

Sub test()
    a = Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 2)) Then
                .Add a(i, 2), a(i, 1)
            Else
                .Item(a(i, 2)) = .Item(a(i, 2)) & "," & a(i, 1)
            End If
        Next
        Cells(1, 3).Resize(.Count, 2) = Application.Index(Application.Transpose(Array(.keys, .items)), 0, 0)
    End With
End Sub

Hi,

Thank you for the code. I am getting run time error

 

[zmaniar]

Attached Image

 

[Alex Blakenburg]

The scripting dictionary won't work on Mac OS. You would need to instal an AddIn or Class Module to get the same functionality on Mac OS.
I'm afraid I do not know anymore about VBA on a Mac.

 

[Fluff]

You could also use a formula.

+Fluff 1.xlsm
	A	B	C	D	E
1	ID	Name		Name	IDs
2	10	APPLE		APPLE	10, 120, 174, 410, 578, 600, 615, 625, 889
3	120	APPLE		ORANGE	20, 40, 60, 80, 100, 120
4	174	APPLE
5	410	APPLE
6	578	APPLE
7	600	APPLE
8	615	APPLE
9	625	APPLE
10	889	APPLE
11	20	ORANGE
12	40	ORANGE
13	60	ORANGE
14	80	ORANGE
15	100	ORANGE
16	120	ORANGE
Master

Cell Formulas
Range	Formula
E2:E3	E2	=TEXTJOIN(", ",,IF($B$2:$B$16=D2,$A$2:$A$16,""))

 

[zmaniar]

You could also use a formula.

+Fluff 1.xlsm
	A	B	C	D	E
1	ID	Name		Name	IDs
2	10	APPLE		APPLE	10, 120, 174, 410, 578, 600, 615, 625, 889
3	120	APPLE		ORANGE	20, 40, 60, 80, 100, 120
4	174	APPLE
5	410	APPLE
6	578	APPLE
7	600	APPLE
8	615	APPLE
9	625	APPLE
10	889	APPLE
11	20	ORANGE
12	40	ORANGE
13	60	ORANGE
14	80	ORANGE
15	100	ORANGE
16	120	ORANGE
Master

Cell Formulas
Range	Formula
E2:E3	E2	=TEXTJOIN(", ",,IF($B$2:$B$16=D2,$A$2:$A$16,""))

Thank you! It worked

 

[Fluff]

Glad we could help & thanks for the feedback.