How to Transpose header row value group by particular column value - excel

Question

I have some data in excel in following format:
Cust_Name Prod1 Prod2 Prod3 Prod4 Prod5
A 0 100 120 0 0
B 145 120 168 0 200
C 350 300 0 340 0
I need to convert the following format in below-mentioned report format.
I want to transpose those product in a column group by Cust_Name which has value >0 else it shouldn't be part of final output report.
I have tried many pivot option but it didn't work.
Required Output:
Cust_Name Product Price
A Prod2 100
Prod3 120
Total A - 220
B Prod1 145
Prod2 120
Prod3 168
Prod5 200
Total B - 633
C Prod1 350
Prod2 300
Prod4 340
Total C - 890

Answer 1

You can do this with PowerQuery.
Select any cell in your source data. Use Data>Get & Transform Data>From Table/Range.
The PowerQuery editor will open, like this:
Select the Cust_Name column by clicking the column header. Use Transform>Unpivot Columns>Unpivot Other Columns:
At this point, optionally filter the Value column to exclude 0.
Now use Home>Close & Load to put the data back into your workbook.
You can now create a pivot table to get your sub totals:
Here is the query from the Advanced Editor dialog in the PowerQuery editor:
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Cust_Name", type text}, {"Prod1", Int64.Type}, {"Prod2", Int64.Type}, {"Prod3", Int64.Type}, {"Prod4", Int64.Type}, {"Prod5", Int64.Type}}),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Cust_Name"}, "Attribute", "Value")
in
#"Unpivoted Other Columns"

Answer 2

If you need a VBA solution, please test the next code. It will return in another sheet the processing result. It is designed to process as many products are on the sheet (in the headers row). The code should be very fast, all processing being done in memory:
Sub TransposeSummarize()
Dim sh As Worksheet, shRet As Worksheet, lastR As Long, lastCol As Long, dict As Object
Dim arr, arrFin, arrDict, i As Long, J As Long, k As Long, count As Long
Set sh = ActiveSheet
Set shRet = sh.Next 'use here the sheet you need returning
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column 'last column
arr = sh.Range("A1", sh.cells(lastR, lastCol)).Value 'place the range in an array for faster iteration
ReDim arrDict(UBound(arr, 2) - 2) 'Redim the arrDict for first time
Set dict = CreateObject("Scripting.Dictionary") 'set the Dictionary (Scripting) object
For i = 2 To UBound(arr) 'iterate between the array elements (rows and columns)
For J = 2 To UBound(arr, 2)
arrDict(J - 2) = arr(i, J) 'fill arrDict with values on the i row
Next J
dict(arr(i, 1)) = arrDict 'place the array as dictionary item
Erase arrDict: ReDim arrDict(UBound(arr, 2) - 2) 'reinitialize the necessary array
Next i
ReDim arrFin(1 To dict.count * lastCol + 1, 1 To 3): k = 1
'Put the Headers in the final array:
arrFin(1, 1) = "Cust_Name": arrFin(1, 2) = "Product": arrFin(1, 3) = "Price": k = 2
For i = 0 To dict.count - 1 'process the dictionary keys/items and create the final array
arrFin(k, 1) = dict.Keys()(i)
For J = 0 To UBound(dict.Items()(i))
If dict.Items()(i)(J) <> 0 Then
arrFin(k, 2) = arr(1, J + 2): arrFin(k, 3) = dict.Items()(i)(J)
count = count + dict.Items()(i)(J): k = k + 1
End If
Next J
arrFin(k, 1) = "Total " & dict.Keys()(i): arrFin(k, 2) = "-": arrFin(k, 3) = count
count = 0: k = k + 1
Next i
'drop the array content at once, at the end of the code:
shRet.Range("A1").resize(k - 1, UBound(arrFin, 2)).Value = arrFin
End Sub
Edited:
I overcomplicated the above code only because I started working at it before receiving the answer regarding the unique "cust_names". I intended to use the dictionary to also process multiple such names. The next version, does not use a dictionary, anymore and extracts the final array content only processing the first one. Just playing with VBA:
Sub TransposeSummarizeUnique()
Dim sh As Worksheet, shRet As Worksheet, lastR As Long, lastCol As Long
Dim arr, arrFin, i As Long, J As Long, k As Long, count As Long
Set sh = ActiveSheet
Set shRet = sh.Next 'use here the sheet you need returning
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column 'last column
arr = sh.Range("A1", sh.cells(lastR, lastCol)).Value 'place the range in an array for faster iteration
ReDim arrFin(1 To UBound(arr) * lastCol + 1, 1 To 3)
'Put the Headers in the final array:
arrFin(1, 1) = "Cust_Name": arrFin(1, 2) = "Product": arrFin(1, 3) = "Price": k = 2
For i = 2 To UBound(arr) 'iterate between the array rows:
arrFin(k, 1) = arr(i, 1) 'fill the customer name
For J = 2 To UBound(arr, 2) 'iterate beteen the array columns"
If arr(i, J) <> 0 Then
arrFin(k, 2) = arr(1, J): arrFin(k, 3) = arr(i, J)'fill the product and its value
count = count + arr(i, J): k = k + 1 'calculate the values sum
End If
Next J
'write the balance row (Total, Sum):
arrFin(k, 1) = "Total " & arr(i, 1): arrFin(k, 2) = "-": arrFin(k, 3) = count
count = 0: k = k + 1 'reinitialize the count and increment the array row
Next i
'drop the array content at once, at the end of the code:
shRet.Range("A1").resize(k - 1, UBound(arrFin, 2)).Value = arrFin
End Sub