Excel Macro to Unstack Data

Question

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:

And my output data should look like:

Ideally, I'd like to see the macro two ways- in this case, it's pulling in 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!!

Answer 1

This should do what you want by unstacking the data to Sheet2 so that Sheet1 isn't overwritten - basically the safer thing to do. It doesn't create a table in Sheet2 but just writes out the data.

It consists of two inner loops: one that iterates over rows with identical codes and another that iterates over the rest. You have to ensure that the header value of Cell B1 isn't equal to the 1st ID value - which shouldn't be a problem given that your IDs are numbers and B1 will always be "ID".

Sub UnstackData()
  Dim wSht1 As Worksheet, wSht2 As Worksheet
  Set wSht1 = Sheets("Sheet1")
  Set wSht2 = Sheets("Sheet2")

  Dim r As Integer: r = 2
  Dim r2 As Integer: r2 = 1
  Dim r1 As Integer, c2 As Integer

  With wSht1
    wSht2.Rows(1).Value = .Rows(1).Value
    r1 = .Cells(.Rows.Count, "A").End(xlUp).Row

    Do While r <= r1
      c2 = 6

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

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

    Loop

  End With

End Sub