Functions/VBA for regrouping and merging data

[VoidGenome]

Could anyone please point me in right directions on how to do this with functions/VBA?

The input range is fixed (A3:B10), but the data in both columns are variables.

 

[Fluff]

Hi & welcome to MrExcel.
What version of Xl are you using?

 

[alansidman]

Can be done with Power Query. Here is MCode

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Transposed Table" = Table.Transpose(Source),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Merged Columns" = Table.CombineColumns(#"Promoted Headers",{"1A", "1A_1", "1A_2"},Combiner.CombineTextByDelimiter(", ", QuoteStyle.None),"1A.1"),
    #"Merged Columns1" = Table.CombineColumns(#"Merged Columns",{"2A", "2A_3"},Combiner.CombineTextByDelimiter(", ", QuoteStyle.None),"2A.1")
in
    #"Merged Columns1"

 

[VoidGenome]

Hi & welcome to MrExcel.
What version of Xl are you using?

Sorry to include that. Excel 2016.

 

[Peter_SSs]

With functions if you have the TEXTJOIN function in your Excel version
Both formulas copied down.

Excel 365
	A	B	C	D	E
2	Class	Name
3	1A	John		1A	John, Mary, Peter
4	1A	Mary		2A	Thomas, Rosie
5	1A	Peter		C3	Luna
6	2A	Thomas
7	2A	Rosie
8	C3	Luna
9
10
Sheet2

Cell Formulas
Range	Formula
D3	=IFERROR(INDEX($A$3:$A$10,MATCH(0,INDEX(COUNTIF($D$2:D2,$A$3:$A$10)+(A$3:A$10=""),0),0)),"")
E3	{=IF(D3="","",TEXTJOIN(", ",1,IF(A$3:A$10=D3,B$3:B$10,"")))}
Press CTRL+SHIFT+ENTER to enter array formulas.

With VBA, try ..

Sub ClassNames()
  Dim d As Object
  Dim c As Range
  
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("A3", Range("A" & Rows.Count).End(xlUp))
    If d.exists(c.Value) Then
      d(c.Value) = d(c.Value) & ", " & c.Offset(, 1).Value
    Else
      d(c.Value) = c.Offset(, 1).Value
    End If
  Next c
  Range("D3:E3").Resize(d.Count).Value = Application.Transpose(Array(d.Keys, d.Items))
End Sub

 

[VoidGenome]

Can be done with Power Query. Here is MCode

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Transposed Table" = Table.Transpose(Source),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Merged Columns" = Table.CombineColumns(#"Promoted Headers",{"1A", "1A_1", "1A_2"},Combiner.CombineTextByDelimiter(", ", QuoteStyle.None),"1A.1"),
    #"Merged Columns1" = Table.CombineColumns(#"Merged Columns",{"2A", "2A_3"},Combiner.CombineTextByDelimiter(", ", QuoteStyle.None),"2A.1")
in
    #"Merged Columns1"

I'm not sure if Power Query is available on my office computer.....(I'm writing this excel to help me during work). I'll check it out tomorrow!

 

[mohadin]

Hi
What about

Sub TEST()    Dim a, i
        With CreateObject("scripting.dictionary")
            For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 2
                a = Range(Cells(3, 1), Cells(12, 2))
                If Not .exists(a(i, 1)) Then
                    .Add a(i, 1), a(i, 2)
                Else
                    .Item(a(i, 1)) = .Item(a(i, 1)) & "," & a(i, 2)
                End If
            Next
            Cells(3, 5).Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
        End With
End Sub

 

[VoidGenome]

Ok problem solved. Thank you very much on your help!

 

[mohadin]

You Are very well come

 

[Peter_SSs]

Ok problem solved. Thank you very much on your help!

You're welcome, glad to help.

As a matter of interest, did you go with the formula approach, macro or power query?