Column Data to Rows

[Dave Patton]

I have about 15000 rows of data in 2 columns
Column A names about 1600 unique names
Column B information from 1 to 19 by name

How do I rearrange the data to multiple columns?

initial information

Student Courses Sep 17 2023.xlsx
	A	B
1	Sep. 17, 2023
2	A,A	Q1D MDR--08--T-01
3	A,A	Q2D XHL--08OES-02
4	A,A	s1&2A MEN--08--Y-03
5	A,A	s1&2C MMA--08--Y-03
6	A,A	s1&2G MCE--08--Y-03
7	A,A	S2D MDR--08PAS-01
8	A,A	s1&2B MFR--08--Y-05
9	A,B	s1&2H XAT--12ABD-01
10	A,B	S1A MFOOD11--S-01
11	A,B	S1B MGENO12--S-01
12	A,B	S1C YIPS-1A--S-06
13	A,B	S1D MNMD-11--S-02
14	A,B	S2A MODED11--S-03
15	A,B	S2B MPREC11--S-07
16	A,B	S2C MPH--11--S-04
17	A,B	S2D MACLV11B-S-01
Sheet2_2

Required

Student Courses Sep 17 2023.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Names	Courses	Data1	data 2	data 3	data 4	data 5	data 6	data 7	data 8	data 9	data 10
2	A,A	7	Q1D MDR--08--T-01	Q2D XHL--08OES-02	s1&2A MEN--08--Y-03	s1&2C MMA--08--Y-03	s1&2G MCE--08--Y-03	S2D MDR--08PAS-01	s1&2B MFR--08--Y-05
3	A,B	9	s1&2H XAT--12ABD-01	S1A MFOOD11--S-01	S1B MGENO12--S-01	S1C YIPS-1A--S-06	S1D MNMD-11--S-02	S2A MODED11--S-03	S2B MPREC11--S-07	S2C MPH--11--S-04	S2D MACLV11B-S-01
Sheet3

Cell Formulas
Range	Formula
A2:A1564	A2	=UNIQUE(Sheet2_2!A2:A12586)
B2:B3	B2	=COUNTIF(Sheet2_2!A2:A12500,A2)
Dynamic array formulas.

 

[kevin9999]

There's a number of ways you could do this, here's one option. (Assumes your headers already exist in Sheet3)

Option Explicit
Sub DaveP()
    Dim ws2 As Worksheet, ws3 As Worksheet
    Set ws2 = Worksheets("Sheet2_2")        '<-- *** Check sheet names ***
    Set ws3 = Worksheets("Sheet3")
    Dim d As Object, i As Long, a, k
    Set d = CreateObject("scripting.dictionary")
    a = ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp))
    
    ws3.UsedRange.Offset(1).ClearContents
    With ws2
        If .AutoFilterMode Then .AutoFilter.ShowAllData
        With d
            For i = 1 To UBound(a, 1)
                d(a(i, 1)) = 1
            Next i
            For Each k In .keys
                With ws2.Range("A1").CurrentRegion
                    .AutoFilter 1, k
                    .Offset(1, 1).Copy
                    ws3.Cells(Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial Transpose:=True
                    Application.CutCopyMode = False
                    .AutoFilter
                End With
            Next k
        End With
    End With
    
    ws3.Cells(2, 1).Resize(d.Count, 1).Value = Application.Transpose(d.keys)
    With ws3.Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Formula2R1C1 = "=counta(RC3:RC21)"
        .Value2 = .Value2
    End With
End Sub

 

[alansidman]

an alternative is with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Grouped Rows" = Table.Group(Source, {"Column1"}, {{"Data", each _, type table [Column1=text, Column2=text]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.AddIndexColumn([Data], "I",1,1)),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"Data"}),
    #"Expanded Custom" = Table.ExpandTableColumn(#"Removed Columns", "Custom", {"Column2", "I"}, {"Column2", "I"}),
    #"Added Prefix" = Table.TransformColumns(#"Expanded Custom", {{"I", each "Data " & Text.From(_, "en-US"), type text}}),
    #"Pivoted Column" = Table.Pivot(#"Added Prefix", List.Distinct(#"Added Prefix"[I]), "I", "Column2")
in
    #"Pivoted Column"

 

[Fluff]

A formula option

Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1	Names	Courses	Data1	data 2	data 3	data 4	data 5	data 6	data 7	data 8	data 9	data 10
2	A,A	7	Q1D MDR--08--T-01	Q2D XHL--08OES-02	s1&2A MEN--08--Y-03	s1&2C MMA--08--Y-03	s1&2G MCE--08--Y-03	S2D MDR--08PAS-01	s1&2B MFR--08--Y-05
3	A,B	9	s1&2H XAT--12ABD-01	S1A MFOOD11--S-01	S1B MGENO12--S-01	S1C YIPS-1A--S-06	S1D MNMD-11--S-02	S2A MODED11--S-03	S2B MPREC11--S-07	S2C MPH--11--S-04	S2D MACLV11B-S-01
Sheet3

Cell Formulas
Range	Formula
A2:K3	A2	=LET(u,UNIQUE(FILTER(Sheet2_2!A2:A10000,Sheet2_2!A2:A10000<>"")),c,COUNTIFS(Sheet2_2!A:A,u),HSTACK(u,c,DROP(REDUCE("",u,LAMBDA(x,y,VSTACK(x,EXPAND(TOROW(FILTER(Sheet2_2!B2:B10000,Sheet2_2!A2:A10000=y)),,MAX(c),"")))),1)))
Dynamic array formulas.

 

[Dave Patton]

Thanks very much Kevin9999, Alansidman, and Fluff; excellent suggestions.

I marked Fluff's solution as the answer since my friend's file is not an xlsm file.

 

[Fluff]

Glad we could help & thanks for the feedback.