Macro Help - Transpose Quantity and QTR (Large amount of data)

T

tommiexboi

New Member
Joined
Apr 24, 2017
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hello,

Basically, I have over 1200 part numbers and I'm looking at an 8 quarter forecast.
I am trying to get the below result that will be quick and efficient. Would like to be able to sort by quarter and etc.

Any help will be greatly appreciated.


Current:
[TABLE="class: grid, width: 598"]
<tbody>[TR]
[TD]Part Number[/TD]
[TD]QTR 1[/TD]
[TD]QTR 2[/TD]
[TD]QTR 3[/TD]
[TD]QTR 4[/TD]
[TD]QTR 1[/TD]
[TD]QTR 2[/TD]
[TD]QTR 3[/TD]
[TD]QTR 4[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]67[/TD]
[TD]8[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]0[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]10[/TD]
[TD]4[/TD]
[TD]2[/TD]
[TD]6[/TD]
[TD]0[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]ABC125[/TD]
[TD]3[/TD]
[TD]5[/TD]
[TD]12[/TD]
[TD]5[/TD]
[TD]3[/TD]
[TD]9[/TD]
[TD]3[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]

Result Needed:
[TABLE="class: grid, width: 360"]
<tbody>[TR]
[TD]Part Number[/TD]
[TD]Quarter[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 1[/TD]
[TD]67[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 2[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 3[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 4[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 3[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]QTR 4[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 2[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 3[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 4[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 1[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 2[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 3[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 4[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 1[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 2[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 3[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 4[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 1[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 2[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 3[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]ABC124[/TD]
[TD]QTR 4[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Try this with a copy of your data.

Code: 
Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A1").CurrentRegion
    a = .Value
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    For i = 2 To UBound(a, 1)
      For j = 2 To UBound(a, 2)
        k = k + 1
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    With .Offset(1, .Columns.Count + 2).Resize(UBound(b), 3)
      .Value = b
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      .EntireColumn.AutoFit
    End With
  End With
End Sub

Here is my data (cols A:I) and results of that code (cols L:N)

Excel Workbook
ABCDEFGHIJKLMN
1Part NumberQTR 1QTR 2QTR 3QTR 4QTR 1QTR 2QTR 3QTR 4Part NumberQuarterQuantity
2ABC123678831304ABC123QTR 167
3ABC124121042606ABC123QTR 28
4ABC125351253933ABC123QTR 38
5ABC123QTR 43
6ABC123QTR 11
7ABC123QTR 23
8ABC123QTR 30
9ABC123QTR 44
10ABC124QTR 11
11ABC124QTR 22
12ABC124QTR 310
13ABC124QTR 44
14ABC124QTR 12
15ABC124QTR 26
16ABC124QTR 30
17ABC124QTR 46
18ABC125QTR 13
19ABC125QTR 25
20ABC125QTR 312
21ABC125QTR 45
22ABC125QTR 13
23ABC125QTR 29
24ABC125QTR 33
25ABC125QTR 43
Transpose
 
Upvote 0
Awesome! This works!

Now a little bit more:
- How about if the result needs to be on a different sheet (lets say Sheet2) and start from A2.

Also could you explain how this macro works (possibly a step by step) so that I can play around with it?

Thanks
 
Upvote 0
See if this is sufficient.

Rich (BB code): 
Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imaginec this array to look like the data on the sheet
    a = .Value
    'Make array b big enough to hold results - basically rows of data numbers x columns of data numbers
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    'For each row of numbers
    For i = 2 To UBound(a, 1)
      'Work across all the columns in that row of numbers
      For j = 2 To UBound(a, 2)
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'column header' for that value
        '3rd value is the numerical value itsef
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 3)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub
 
Upvote 0
Peter_SSs said:
See if this is sufficient.

Rich (BB code): 
Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imaginec this array to look like the data on the sheet
    a = .Value
    'Make array b big enough to hold results - basically rows of data numbers x columns of data numbers
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    'For each row of numbers
    For i = 2 To UBound(a, 1)
      'Work across all the columns in that row of numbers
      For j = 2 To UBound(a, 2)
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'column header' for that value
        '3rd value is the numerical value itsef
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 3)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub
Click to expand...

Hi Peter or anyone that can help!

The macro helped me out greatly and I really appreciate it! But now I ran into another issue, I have another measure that needs to be transposed.
Also the QTR's can vary.. Sometimes it's QTR 1~QTR 4 or QTR 1~QTR 8 depending on which report I'm running.

Current:

QuantityQuantityQuantityQuantityPricePricePricePrice
Part NumberQTR 1QTR 2QTR 3QTR 4QTR 1QTR 2QTR 3QTR 4
ABC123100150200250$3$3$1$3
ABC124200200200200$2$1$1$5
ABC125150150100100$3$3$3$3

Needed Results

Part NumberQuarterQuantityPrice
ABC123QTR 1100$3
ABC123QTR 2150$3
ABC123QTR 3200$1
ABC123QTR 4250$3
ABC124QTR 1200$2
ABC124QTR 2200$1
ABC124QTR 3200$1
ABC124QTR 4200$5
ABC125QTR 1150$3
ABC125QTR 2150$3
ABC125QTR 3100$3
ABC125QTR 4100$3

Thank you in advance
 
Upvote 0
tommiexboi said:
I have another measure that needs to be transposed.
Click to expand...
Try this

VBA Code: 
Sub TransposeQuarters_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, numQtrs As Long
  
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imagine this array to look like the data on the sheet
    a = .Value
    'Calculate how many quarters
    numQtrs = (UBound(a, 2) - 1) / 2
    'Make array b big enough to hold results - basically rows of data numbers x no. of 'Price' columns
    ReDim b(1 To (UBound(a, 1) - 2) * numQtrs, 1 To 4)
    'For each row of numbers
    For i = 3 To UBound(a, 1)
      'Work across all the Quarter columns in that row
      For j = 2 To 1 + numQtrs
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'Qtr header' for that value
        '3rd value is the Qtr Quantity
        '4th value is the Qtr Price
        b(k, 1) = a(i, 1): b(k, 2) = a(2, j): b(k, 3) = a(i, j): b(k, 4) = a(i, j + numQtrs)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 4)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity", "Price")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub
 
Upvote 0
Load your table to Power Query/Get and Transform. Unpivot the table. Load to Excel. Mcode follows.

VBA Code: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Part Number"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"

Book1
ABC
1Part NumberAttributeValue
2ABC123QTR 167
3ABC123QTR 28
4ABC123QTR 38
5ABC123QTR 43
6ABC123QTR 121
7ABC123QTR 233
8ABC123QTR 340
9ABC123QTR 454
10ABC124QTR 11
11ABC124QTR 22
12ABC124QTR 310
13ABC124QTR 44
14ABC124QTR 122
15ABC124QTR 236
16ABC124QTR 340
17ABC124QTR 456
18ABC125QTR 13
19ABC125QTR 25
20ABC125QTR 312
21ABC125QTR 45
22ABC125QTR 123
23ABC125QTR 239
24ABC125QTR 343
25ABC125QTR 453
Sheet4
 
Upvote 0
with Power Query
Part NumberQtrQtyPrice
ABC123QTR 11003
ABC123QTR 21503
ABC123QTR 32001
ABC123QTR 42503
ABC124QTR 12002
ABC124QTR 22001
ABC124QTR 32001
ABC124QTR 42005
ABC125QTR 11503
ABC125QTR 21503
ABC125QTR 31003
ABC125QTR 41003

Rich (BB code): 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

    TSC = Table.SelectColumns(Source,{"Column1", "Column2", "Column3", "Column4", "Column5"}),
    UOC = Table.UnpivotOtherColumns(Table.PromoteHeaders(Table.PromoteHeaders(TSC, [PromoteAllScalars=true]), [PromoteAllScalars=true]), {"Part Number"}, "Qtr", "Qty"),

    TSC1 = Table.SelectColumns(Source,{"Column1", "Column6", "Column7", "Column8", "Column9"}),
    UOC1 = Table.UnpivotOtherColumns(Table.PromoteHeaders(Table.PromoteHeaders(TSC1, [PromoteAllScalars=true]), [PromoteAllScalars=true]), {"Part Number"}, "Qtr", "Price"),

    Price = Table.AddColumn(UOC1, "Pricex", each "Price"),
    Pivot = Table.Pivot(Price, List.Distinct(Price[Pricex]), "Pricex", "Price"),

    Mrg = Table.NestedJoin(UOC,{"Part Number", "Qtr"},Pivot,{"Part Number", "Qtr"},"Table",JoinKind.LeftOuter),
    Result = Table.TransformColumnTypes(Table.ReplaceValue(Table.ExpandTableColumn(Mrg, "Table", {"Price"}, {"Price"}),"$","",Replacer.ReplaceText,{"Price"}),{{"Qty", type number}, {"Price", type number}})

in
    Result
 
Upvote 0
Thank you all!
I still need to learn power query. Seems like it's something much useful in this day and age.

I really appreciate your help!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Sufiyan97
  • Solved
Filter all the data for multiple IDs on separate tab Excel 2013
2
Replies
19
Views
660
Georgiboy
Georgiboy
M
  • Solved
Shopping Cart - Most commonly purchased with?
Replies
9
Views
517
Peter_SSs
Peter_SSs
D
  • Solved
Using FILTER/UNIQUE on text, numbers
2 3 4
Replies
32
Views
2K
KRice
K
N
  • Solved
Dynamic formula to pull in column headers based on column values within a row
Replies
2
Views
247
n64kps
N
B
  • Question Question
Bin Packing Problem - but not quite?
Replies
5
Views
110
Logit
Logit

Forum statistics

Threads
1,224,823
Messages
6,181,169
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top