CONCATENATE Cell values from multiple row into single cell based on Unique Value

[earthworm]

Hi All,

Below is the data set . I need vba and formula approach that can create unique value from Column A and then merge all the values that are distributed into multiple rows into single cell

Example I have shown the required result in Column E and F . Please assist . I am using office 2016

Below formula works well in excel 2021 . However I need formula and vba for older version of excel

=TEXTJOIN(",",TRUE,IF($A$3:$A$21=E3,$C$3:$C$21,""))

Book1
	A	B	C	D	E	F	G
2	A	B	C		Result
3	1	Test 1	AB1		1	AB1,AB2,AB3,AB4	AB1,AB2,AB3,AB4
4	1	Test 2	AB2		2	AB5	AB5
5	1	Test 3	AB3		3	AB6	AB6
6	1	Test 4	AB4		4	AB7,AB8,AB9	AB7,AB8,AB9
7	2	Test 5	AB5		5	AB10	AB10
8	3	Test 6	AB6		6	AB11	AB11
9	4	Test 7	AB7		7	AB12,AB13,AB14,AB16,AB17	AB12,AB13,AB14,AB15,AB16,AB17
10	4	Test 8	AB8		8	AB18	AB18
11	4	Test 9	AB9		9	AB19	AB19
12	5	Test 10	AB10
13	6	Test 11	AB11
14	7	Test 12	AB12
15	7	Test 13	AB13
16	7	Test 14	AB14
17	7	Test 15	AB15
18	7	Test 16	AB16
19	7	Test 17	AB17
20	8	Test 18	AB18
21	9	Test 19	AB19
Sheet1

Cell Formulas
Range	Formula
G3:G11	G3	=TEXTJOIN(",",TRUE,IF($A$3:$A$21=E3,$C$3:$C$21,""))

 

[Akuini]

With vba, try this:

Sub earthworm1()

Dim i As Long, j As Long, k As Long, n As Long
Dim va, vb, tx As String

va = Range("A1", Cells(Rows.Count, "C").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 2)

For i = 2 To UBound(va, 1)
    j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    
    i = i - 1
    tx = ""
        For n = j To i
            tx = tx & "," & va(n, 3)
        Next
    k = k + 1
    vb(k, 1) = va(i, 1)
    If Len(tx) > 1 Then vb(k, 2) = Mid(tx, 2, 100000)
Next

'put the result
Range("E2").Resize(k, 2) = vb
End Sub

Result:

Book1
	A	B	C	D	E	F
1	A	B	C		Result
2	1	Test 1	AB1		1	AB1,AB2,AB3,AB4
3	1	Test 2	AB2		2	AB5
4	1	Test 3	AB3		3	AB6
5	1	Test 4	AB4		4	AB7,AB8,AB9
6	2	Test 5	AB5		5	AB10
7	3	Test 6	AB6		6	AB11
8	4	Test 7	AB7		7	AB12,AB13,AB14,AB15,AB16,AB17
9	4	Test 8	AB8		8	AB18
10	4	Test 9	AB9		9	AB19
11	5	Test 10	AB10
12	6	Test 11	AB11
13	7	Test 12	AB12
14	7	Test 13	AB13
15	7	Test 14	AB14
16	7	Test 15	AB15
17	7	Test 16	AB16
18	7	Test 17	AB17
19	8	Test 18	AB18
20	9	Test 19	AB19
Sheet2

 

[earthworm]

With vba, try this:

Sub earthworm1()

Dim i As Long, j As Long, k As Long, n As Long
Dim va, vb, tx As String

va = Range("A1", Cells(Rows.Count, "C").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 2)

For i = 2 To UBound(va, 1)
    j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
   
    i = i - 1
    tx = ""
        For n = j To i
            tx = tx & "," & va(n, 3)
        Next
    k = k + 1
    vb(k, 1) = va(i, 1)
    If Len(tx) > 1 Then vb(k, 2) = Mid(tx, 2, 100000)
Next

'put the result
Range("E2").Resize(k, 2) = vb
End Sub

Result:

Book1
	A	B	C	D	E	F
1	A	B	C		Result
2	1	Test 1	AB1		1	AB1,AB2,AB3,AB4
3	1	Test 2	AB2		2	AB5
4	1	Test 3	AB3		3	AB6
5	1	Test 4	AB4		4	AB7,AB8,AB9
6	2	Test 5	AB5		5	AB10
7	3	Test 6	AB6		6	AB11
8	4	Test 7	AB7		7	AB12,AB13,AB14,AB15,AB16,AB17
9	4	Test 8	AB8		8	AB18
10	4	Test 9	AB9		9	AB19
11	5	Test 10	AB10
12	6	Test 11	AB11
13	7	Test 12	AB12
14	7	Test 13	AB13
15	7	Test 14	AB14
16	7	Test 15	AB15
17	7	Test 16	AB16
18	7	Test 17	AB17
19	8	Test 18	AB18
20	9	Test 19	AB19
Sheet2

Perfect !! thank you a lot for your support

If you dont mind i will be obliged if you can explain the macro piece by piece for my knowledge and understanding so that in future i can make my own
specially the redim and unbound part . what does it do ?

 

[earthworm]

Anyone else please also share formula approach for old version of excel please

 

[mohadin]

Another code option

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

 

[alansidman]

achieve this by using Power Pivot and Concatenatex function. Here is a tutorial.

IMA Site Maintenance

Row Labels	Concat
1	AB1, AB2, AB3, AB4
2	AB5
3	AB6
4	AB7, AB8, AB9
5	AB10
6	AB11
7	AB12, AB13, AB14, AB15, AB16, AB17
8	AB18
9	AB19

 

[earthworm]

achieve this by using Power Pivot and Concatenatex function. Here is a tutorial.

IMA Site Maintenance

Row Labels	Concat
1	AB1, AB2, AB3, AB4
2	AB5
3	AB6
4	AB7, AB8, AB9
5	AB10
6	AB11
7	AB12, AB13, AB14, AB15, AB16, AB17
8	AB18
9	AB19

will this also work in excel 2016

 

[alansidman]

Yes, so long as you have Power Pivot installed.