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:
[TABLE="width: 345"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Name[/TD]
[TD]Subject[/TD]
[TD]Date[/TD]
[TD]Code[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Bob[/TD]
[TD]Golf[/TD]
[TD]1-Mar[/TD]
[TD]xyz[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Adam[/TD]
[TD]Cards[/TD]
[TD]2-Mar[/TD]
[TD]xcv[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Joe[/TD]
[TD]Cards[/TD]
[TD]5-Mar[/TD]
[TD]xch[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Will[/TD]
[TD]Travel[/TD]
[TD]6-Mar[/TD]
[TD]vvv[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Bill[/TD]
[TD]Travel[/TD]
[TD]1-Mar[/TD]
[TD]crt[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Thrill[/TD]
[TD]Travel[/TD]
[TD]2-Mar[/TD]
[TD]abt[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Napoleon[/TD]
[TD]Grapeshot[/TD]
[TD]3-Mar[/TD]
[TD]xso[/TD]
[/TR]
</tbody>[/TABLE]

And my output data should look like:
[TABLE="width: 601"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Name[/TD]
[TD]Subject[/TD]
[TD]Date[/TD]
[TD]Code[/TD]
[TD]Column1[/TD]
[TD]Column2[/TD]
[TD]Column3[/TD]
[TD]Column4[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Bob[/TD]
[TD]Golf[/TD]
[TD]1-Mar[/TD]
[TD]xyz[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Adam[/TD]
[TD]Cards[/TD]
[TD]2-Mar[/TD]
[TD]xcv[/TD]
[TD]Joe[/TD]
[TD]Cards[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Will[/TD]
[TD]Travel[/TD]
[TD]6-Mar[/TD]
[TD]vvv[/TD]
[TD]Bill[/TD]
[TD]Travel[/TD]
[TD]Thrill[/TD]
[TD]Travel[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Napoleon[/TD]
[TD]Grapeshot[/TD]
[TD]3-Mar[/TD]
[TD]xso[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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]