VBA Macro to Unstack Data

[fouraces]

I have data that has been stacked prior to my receiving it. There are multiple rows of values for a single unifying ID. I'd like to convert those multiple rows into a single row by adding columns and pulling in a specified range of data. So my initial data looks like:

ID	Name	Subject	Date	Code
1	Bob	Golf	1-Mar	xyz
2	Adam	Cards	2-Mar	xcv
2	Joe	Cards	5-Mar	xch
3	Will	Travel	6-Mar	vvv
3	Bill	Travel	1-Mar	crt
3	Thrill	Travel	2-Mar	abt
4	Napoleon	Grapeshot	3-Mar	xso

<tbody>
</tbody>

And my output data should look like:

ID	Name	Subject	Date	Code	Column1	Column2	Column3	Column4
1	Bob	Golf	1-Mar	xyz
2	Adam	Cards	2-Mar	xcv	Joe	Cards
3	Will	Travel	6-Mar	vvv	Bill	Travel	Thrill	Travel
4	Napoleon	Grapeshot	3-Mar	xso

<tbody>
</tbody>

Ideally, I'd like to see the macro two ways- in this case, it's pulling from a range of columns that are together (B:C). However, I'd also like to see it if the columns needed were not consecutive (B and E for example).
Thanks for any help, appreciate it!!

 

[Ruddles]

I'm dashing to go out so I can't write you any VBA at the moment but... can this be done with a pivot table?

 

[fouraces]

I'm dashing to go out so I can't write you any VBA at the moment but... can this be done with a pivot table?

Thanks for your reply. A standard pivot table cannot display text values, which my columns typically are. In my research, I saw that Get and Transform (aka PowerQuery) might be able to make a semblance of this. However, for a data set of any size (even 100 rows), I couldn't get this result- not even close really. If you have a method to do it manually as a process, that would certainly be welcome as well. I can get there using IF formulas, but in the very possible scenario that there may be 20+ rows tied to the same ID, and I need to pull 7 columns for each row, it takes a fair bit of time to adjust the formulas in every new column. More importantly is avoiding the potential for manual error as well. Thanks!

 

[fouraces]

In case anyone else runs into this issue, wanted to post the code I ended up using (disclaimer: got some help to get it done)

[FONT=Calibri]Sub UnstackData()[/FONT][FONT=Calibri]  Dim wSht1 As Worksheet, wSht2 As Worksheet[/FONT]
[FONT=Calibri]  Set wSht1 = Sheets("Sheet1")[/FONT]
[FONT=Calibri]  Set wSht2 = Sheets("Sheet2")[/FONT]

[FONT=Calibri]  Dim r As Integer: r = 2[/FONT]
[FONT=Calibri]  Dim r2 As Integer: r2 = 1[/FONT]
[FONT=Calibri]  Dim r1 As Integer, c2 As Integer[/FONT]

[FONT=Calibri]  With wSht1[/FONT]
[FONT=Calibri]    wSht2.Rows(1).Value = .Rows(1).Value[/FONT]
[FONT=Calibri]    r1 = .Cells(.Rows.Count,"A").End(xlUp).Row[/FONT]

[FONT=Calibri]    Do While r <= r1[/FONT]
[FONT=Calibri]      c2 = 16 [/FONT]

[FONT=Calibri]      Do While .Cells(r, "A") =.Cells(r - 1, "A")[/FONT]
[FONT=Calibri]        wSht2.Cells(r2, c2).Value = .Cells(r,"B").Value[/FONT]
[FONT=Calibri]        wSht2.Cells(r2, c2 + 1).Value =.Cells(r, "C").Value[/FONT]
[FONT=Calibri]        c2 = c2 + 2[/FONT]
[FONT=Calibri]        r = r + 1[/FONT]
[FONT=Calibri]      Loop[/FONT]
[FONT=Calibri]      r2 = r2 + 1[/FONT]

[FONT=Calibri]      Do While .Cells(r, "A")<> .Cells(r - 1, "A")[/FONT]
[FONT=Calibri]        wSht2.Range("A" & r2& ":E" & r2).Value = .Range("A" & r &":E" & r).Value[/FONT]
[FONT=Calibri]        r = r + 1[/FONT]
[FONT=Calibri]        r2 = r2 + 1[/FONT]
[FONT=Calibri]      Loop[/FONT]
[FONT=Calibri]      r2 = r2 - 1[/FONT]

[FONT=Calibri]    Loop[/FONT]

[FONT=Calibri]  End With[/FONT]

[FONT=Calibri]End Sub[/FONT]