Hi, I have a table of data as below with 6 columns of descriptors and year and month/period data extending to the right. I am trying to convert this to a list format, also shown below. I had attempted to amend some VBA code that had a similar table but with three static label columns, I thought this would be quite easy but haven't been able to get it to work. I have included the original VBA code below to avoid any confusion being caused by my meddling.
If someone can advise of a solution to this or if you have a better way to do it then that would be much appreciated!
Original table:
<tbody>
</tbody>
Desired List:
<tbody>
</tbody>
<tbody>
</tbody>
If someone can advise of a solution to this or if you have a better way to do it then that would be much appreciated!
Original table:
| 2016 | 2016 | 2016 | |||||||
| Program | Variant | Deliverables | Supplier | Vendor No. | Package | Jan | Feb | Mar | |
| P1 | V1 | D1 | S1 | VN1 | PA1 | 1 | 2 | 1 | |
| P1 | V2 | D2 | S2 | VN2 | PA2 | 3 | 1 | 4 |
<tbody>
</tbody>
Desired List:
| Program | Variant | Deliverables | Supplier | Vendor No. | Package | Year | Month/Period | Quantity |
| P1 | V1 | D1 | S1 | VN1 | PA1 | 2016 | JAN | 1 |
| P1 | V1 | D1 | S1 | VN1 | PA1 | 2016 | FEB | 2 |
| P1 | V1 | D1 | S1 | VN1 | PA1 | 2016 | MAR | 1 |
<tbody>
</tbody>
Code:
Sub CrossTabToList()
'written by Doctor Moxie
Dim wsCrossTab As Worksheet
Dim wsList As Worksheet
Dim iLastCol As Long
Dim iLastRow As Long
Dim iLastRowList As Long
Dim rngCTab As Range 'Used for range in Sheet1 cross tab sheet
Dim rngList As Range 'Destination range for the list
Dim ROW As Long
Set wsCrossTab = Worksheets("Sheet1") 'AMEND TO SHOW SHEET NUMBER WITH THE CROSS TAB
Set wsList = Worksheets.Add
'Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, "A").End(xlUp).ROW
'Set the initial value for the row in the destination worksheet
'I set mine as 2 as I want to put headings in row 1
iLastRowList = 2
'Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range("A2").End(xlToRight).Column
'Set the heading titles in the list sheet
'You will need to amend these to something appropriate for your sheet
wsList.Range("A1:F1") = Array("NAME", "PROJECT", "TYPE", "PLAN/ACTUAL", "WEEK", "HOURS")
'Start looping through the cross tab data
For ROW = 3 To iLastRow 'START AT ROW 3 AS THIS IS WHERE DATA BEGINS IN MY CROSS TAB
Set rngCTab = wsCrossTab.Range("A" & ROW, "C" & ROW) 'initial value A3 SETS THE RANGE TO INCLUDE ALL STATIC DATA - IN THIS CASE NAME, PROJECT, TYPE
Set rngList = wsList.Range("A" & iLastRowList) 'initial value A2
'Copy individual names in Col A (A3 initially) into as many rows as there are data columns
'in the cross tab (less 3 for Col A-C).
rngCTab.Copy rngList.Resize(iLastCol - 3)
'SELECT THE HEADING ROW WITH FORECAST/ACTUAL
'Move up ROW (INITIALLY 3) rows less TWO and across 3 columns (using offset function). Copy.
rngCTab.Offset(-(ROW - 2), 3).Resize(, iLastCol - 3).Copy
'Paste transpose to columns in the list sheet alongside the static data
rngList.Offset(0, 3).PasteSpecial Transpose:=True
'SELECT THE ROW WITH THE WEEK NUMBERS
'Move up ROW (INITIALLY 3) rows less ONE and across 3 columns (using offset function). Copy.
rngCTab.Offset(-(ROW - 1), 3).Resize(, iLastCol - 3).Copy
'Paste transpose to columns in the list sheet alongside the static data
rngList.Offset(0, 4).PasteSpecial Transpose:=True
'Staying on same row (3 initially) copy the data from the cross tab
rngCTab.Offset(, 3).Resize(, iLastCol - 3).Copy
'Past transpose as column in list sheet
rngList.Offset(0, 5).PasteSpecial Transpose:=True
'Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol - 3)
'increment ROW by 1
Next ROW
End Sub<tbody>
</tbody>
