Macro to flatten certain columns of a table into individual rows

[SushantJain]

Hi Guys,

I am new to macros and i have my current data in Excel 2007 in this format below:

But i want to converge Electricity use, Gas use and Oil use under a common column names as energy use, as below:

Can you please help me with the Macro/ VBA code required to automate this task?

Cheers
Sushant

 

[onlyadrafter]

Hello,

Have assumed 'Supplier' in in Cell A1 and have assumed you want the data in the same place. Have taken your request as literal.

Sub ENERGY()
    Columns("D:F").Insert
    Range("D1").Value = "Energy Type"
    Range("E1").Value = "Value"
    Range("F1").Value = "Production Share"
    For MY_ROWS = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Range(Cells(MY_ROWS + 1, 1), Cells(MY_ROWS + 2, 1)).EntireRow.Insert
        Range("A" & MY_ROWS & ":C" & MY_ROWS).Copy
        Range(Cells(MY_ROWS + 1, 1), Cells(MY_ROWS + 2, 1)).PasteSpecial (xlPasteValues)
        Range(Cells(MY_ROWS, 7), Cells(MY_ROWS, 9)).Copy
        Cells(MY_ROWS, 5).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True

        Range("G1:I1").Copy
        Cells(MY_ROWS, 4).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
        Cells(MY_ROWS, 10).Copy
        Range(Cells(MY_ROWS, 6), Cells(MY_ROWS + 2, 6)).PasteSpecial (xlPasteValues)
    Next MY_ROWS
    Columns("G:J").Delete
End Sub

Does this work as expected?

 

[hiker95]

SushantJain,

You did not say where you wanted the results to be written to?

Sample raw data in the active worksheet:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Supplier	Supplier Type	Period	Electricity use (kWh)	Gas use (m3)	Oild use (Liters)	Production Share (%)
2	ABC	Disribution Equipment	Jan-13	75,655	100	200	40%
3
4
5
Sheet1

After the macro (using two arrays in memory - should be pretty fast) in the same worksheet:

Excel 2007
	A	G	H	I	J	K	L	M	N	O
1	Supplier	Production Share (%)			Supplier	Supplier Type	Period	Energy Type	Value	Production Share
2	ABC	40%			ABC	Disribution Equipment	Jan-13	Electricity use (kWh)	75,655	40%
3					ABC	Disribution Equipment	Jan-13	Gas use (m3)	100	40%
4					ABC	Disribution Equipment	Jan-13	Oild use (Liters)	200	40%
5
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 12/11/2014, ME823036
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  .Columns("J:O").ClearContents
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  a = .Range("A1:G" & lr)
  ReDim o(1 To (lr - 1) * 3, 1 To 6)
  For i = 2 To lr
    For c = 4 To 6
      j = j + 1
      o(j, 1) = a(i, 1)
      o(j, 2) = a(i, 2)
      o(j, 3) = a(i, 3)
      o(j, 4) = a(1, c)
      o(j, 5) = a(i, c)
      o(j, 6) = a(i, 7)
    Next c
  Next i
  With .Range("J1").Resize(, 6)
    .Value = Array("Supplier", "Supplier Type", "Period", "Energy Type", "Value", "Production Share")
    .Font.Bold = True
  End With
  .Range("J2").Resize(UBound(o, 1), UBound(o, 2)).Value = o
  .Range("L2").Resize(UBound(o, 1)).NumberFormat = "mmm-d"
  .Range("N2").Resize(UBound(o, 1)).NumberFormat = "#,##0"
  .Range("O2").Resize(UBound(o, 1)).NumberFormat = "0%"
  .Columns("J:O").AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.