unpivotting a table with macro

M

Mechixx

Board Regular
Joined
Oct 15, 2015
Messages
59
Hello everyone,

So i had been directed to this thread here:
HTML: 
https://www.mrexcel.com/forum/excel-questions/783577-unpivot-table-2.html?highlight=unpivot+macro

which has a very useful macro for unpivotting data from a table using VBA, works really well and is what i have been looking for, for another question i had posted on this forum.
However, im looking for help on how to revise this macro to work with a table that starts in cell "C9" instead of "A1" just because my table i have slicers and other things above it that i would like to keep.

And if someone is able to help with how this macro outputs the data, id like it to output to a table so that i can then use a pivot table on it to consolidate information. the unpivotted table also has to include a couple extra columns for some calculations.

so heres the macro from the above thread:

Code: 
Option Explicit


Sub UnPivot()
'Set your variables
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim i As Long
    Dim lrS As Long
    Dim lrT As Long
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    lrS = w1.Range("A" & Rows.Count).End(xlUp).Row
    Dim lc As Long [COLOR=#ff0000]'new line[/COLOR]
    lc = Cells(1, Columns.Count).End(xlToLeft).Column [COLOR=#b22222]'new line[/COLOR]


Application.ScreenUpdating = False 'sets screen to update after all is completed so screen does not flutter
    With w1  'work within sheet1
        For i = 2 To lrS  'sets variable to select rows 2 to last row and loop
        lrT = w2.Range("B" & Rows.Count).End(xlUp).Row  'sets the last row in the target worksheet
            .Range("A" & i).Copy w2.Range("A" & lrT + 1) 'copies the range A and row i (variable) to new sheet and places in row after last row
            .Range(Cells(i, 2), Cells(i, lc)).Copy [COLOR=#b22222]'changed  [/COLOR]copies range B to last column in variable row
            w2.Range("B" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column B in target sheet
            .Range(Cells(1, 2), Cells(1, lc)).Copy [COLOR=#b22222]'changed [/COLOR]copies range  B1 to last column in row 1
            w2.Range("C" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column C in target sheet
        Next i
End With
Application.CutCopyMode = False




    With w2  'using the target sheet
    lrT = .Range("B" & Rows.Count).End(xlUp).Row  'finds last row used in column B
        For i = 3 To lrT 'Sets loop
        If .Range("A" & i) = "" Then  'if range A and variable row is empty 
            .Range("A" & i) = .Range("A" & i - 1) 'then copy the value in cell above and paste to it
        End If
        Next i
    End With
Application.ScreenUpdating = True
MsgBox "complete"


End Sub

another weird thing, is that when using this macro, if i try and put it into a button, it gives me an error for some reason...

to better explain what i want this macro to do is take a table like this

[TABLE="class: cms_table_grid, align: left"]
<tbody>[TR]
[TD]Dept.[/TD]
[TD]Part #[/TD]
[TD]Op #[/TD]
[TD]Type of Item[/TD]
[TD]Item Code[/TD]
[TD]Stock #[/TD]
[TD]# of Corners[/TD]
[TD]# of Pieces per Corner[/TD]
[TD]QTY/January[/TD]
[TD]QTY/February[/TD]
[TD]QTY/March[/TD]
[TD]QTY/April[/TD]
[TD]QTY/May[/TD]
[TD]QTY/June[/TD]
[TD]QTY/July[/TD]
[TD]QTY/August[/TD]
[TD]QTY/September[/TD]
[TD]QTY/October[/TD]
[TD]QTY/November[/TD]
[TD]QTY/December[/TD]
[/TR]
[TR]
[TD="align: center"]Auto.[/TD]
[TD="align: center"]S123[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]Insert[/TD]
[TD="align: center"]CNMG 432 PM 4325[/TD]
[TD="align: center"]16392[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]250[/TD]
[TD="align: center"]36[/TD]
[TD="align: center"]32[/TD]
[TD="align: center"]28[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]32[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]40[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[/TR]
[TR]
[TD="align: center"]Auto.[/TD]
[TD="align: center"]S124[/TD]
[TD="align: center"]20[/TD]
[TD="align: center"]Insert[/TD]
[TD="align: center"]WNMG 432-WMX 4215[/TD]
[TD="align: center"]17339[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]150[/TD]
[TD="align: center"]60[/TD]
[TD="align: center"]53[/TD]
[TD="align: center"]47[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]53[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[/TR]
</tbody>[/TABLE]




and turn it into this:

[TABLE="class: cms_table_grid, align: left"]
<tbody>[TR]
[TD]Stock #[/TD]
[TD]Item Code[/TD]
[TD]Part #[/TD]
[TD]Date[/TD]
[TD]Sum of Month[/TD]
[TD]Min of Month[/TD]
[TD]Max of Month[/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Jan[/TD]
[TD]36[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Feb[/TD]
[TD]32[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Mar[/TD]
[TD]28[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Apr[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]May[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Jun[/TD]
[TD]32[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Jul[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Aug[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Sep[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Oct[/TD]
[TD]40[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Nov[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16392[/TD]
[TD]CNMG 432 PM 4325[/TD]
[TD]S123[/TD]
[TD]Dec[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Jan[/TD]
[TD]60[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Feb[/TD]
[TD]53[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Mar[/TD]
[TD]47[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Apr[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]May[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Jun[/TD]
[TD]53[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Jul[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Aug[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Sep[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Oct[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Nov[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17339[/TD]
[TD]WNMG 432-WMX 4215[/TD]
[TD]S124[/TD]
[TD]Dec[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

and the min and max of month columns will be calculated columns
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
** Update

ive been playing around with this, and have it doing what i need to do if the original table starts in "A1", so just looking for some macro help on how i can get this following code to work with my table that starts in "C9"
and also why i cant run this macro with a button, if i could have someone help with those 2 things that would be great!

here's the updated code (yes ive changed it up a bit from the original because i wanted to add more columns to the resulting table):
Code: 
Option Explicit


Sub UnPivot()
'Set your variables
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim i As Long
    Dim lrS As Long
    Dim lrT As Long
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    lrS = w1.Range("A" & Rows.Count).End(xlUp).Row
    Dim lc As Long
    lc = Cells(1, Columns.Count).End(xlToLeft).Column


Application.ScreenUpdating = False 'sets screen to update after all is completed so screen does not flutter
    
    w2.Select
        Rows("5:5").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
    w1.Select
    
    With w1  'work within sheet1
        For i = 2 To lrS  'sets variable to select rows 2 to last row and loop
        lrT = w2.Range("D" & Rows.Count).End(xlUp).Row  'sets the last row in the target worksheet
            .Range("F" & i).Copy w2.Range("A" & lrT + 1) 'copies the range F and row i (variable) to new sheet and places in row after last row
            .Range("E" & i).Copy w2.Range("B" & lrT + 1) 'copies the range E and row i (variable) to new sheet and places in row after last row
            .Range("B" & i).Copy w2.Range("C" & lrT + 1) 'copies the range B and row i (variable) to new sheet and places in row after last row
            
            w1.Range(Cells(i, 10), Cells(i, lc)).Copy 'copies range J to last column in variable row
            w2.Range("D" & lrT + 1).PasteSpecial xlPasteValues, , , True 'pastes to column D in target sheet
            w1.Range(Cells(1, 10), Cells(1, lc)).Copy 'copies range  J1 to last column in row 1
            w2.Range("E" & lrT + 1).PasteSpecial xlPasteValues, , , True 'pastes to column E in target sheet
        Next i
End With
Application.CutCopyMode = False




    With w2  'using the target sheet
    lrT = .Range("D" & Rows.Count).End(xlUp).Row  'finds last row used in column B
        For i = 3 To lrT 'Sets loop
        
        If .Range("A" & i) = "" Then  'if range A and variable row is empty
            .Range("A" & i) = .Range("A" & i - 1) 'then copy the value in cell above and paste to it
        End If
        
        If .Range("B" & i) = "" Then  'if range B and variable row is empty
            .Range("B" & i) = .Range("B" & i - 1) 'then copy the value in cell above and paste to it
        End If
            
        If .Range("C" & i) = "" Then  'if range C and variable row is empty
            .Range("C" & i) = .Range("C" & i - 1) 'then copy the value in cell above and paste to it
        End If
        
        Next i
    End With
Application.ScreenUpdating = True
MsgBox "complete"


End Sub
 
Upvote 0
**Update
Figured out what i had to change to make everything work!

here's the code if anyone is interested:

Code: 
Option Explicit


Sub UnPivot()
'Set your variables
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim i As Long
    Dim lrS As Long
    Dim lrT As Long
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    lrS = w1.Range("C" & Rows.Count).End(xlUp).Row
    Dim lc As Long
    lc = Cells(10, Columns.Count).End(xlToLeft).Column


Application.ScreenUpdating = False 'sets screen to update after all is completed so screen does not flutter
    
Application.CutCopyMode = False 'sets screen to not show cut/copy lines and deletes data after copying.
    
    w2.Visible = True
    w2.Select
        Rows("5:5").Select 'selects row 5, selects all rows down, and deletes to clear the table of old data
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
        w2.Visible = False
    w1.Select
    
    With w1  'work within sheet1
        For i = 10 To lrS  'sets variable to select rows 10 to last row and loop
        lrT = w2.Range("D" & Rows.Count).End(xlUp).Row  'sets the last row in the target worksheet
            w1.Range("H" & i).Copy w2.Range("A" & lrT + 1) 'copies the range H and row i (variable) to new sheet and places in row after last row
            w1.Range("G" & i).Copy w2.Range("B" & lrT + 1) 'copies the range G and row i (variable) to new sheet and places in row after last row
            w1.Range("D" & i).Copy w2.Range("C" & lrT + 1) 'copies the range D and row i (variable) to new sheet and places in row after last row
            
            w1.Range(w1.Cells(i, 12), w1.Cells(i, lc)).Copy 'copies range L to last column in variable row
            w2.Range("D" & lrT + 1).PasteSpecial xlPasteValues, , , True 'pastes to column D in target sheet
            w1.Range(w1.Cells(9, 12), w1.Cells(9, lc)).Copy 'copies range  L1 to last column in row 1
            w2.Range("E" & lrT + 1).PasteSpecial xlPasteValues, , , True 'pastes to column E in target sheet
        Next i
End With

Application.CutCopyMode = False


    With w2  'using the target sheet
    lrT = .Range("D" & Rows.Count).End(xlUp).Row  'finds last row used in column B
        For i = 3 To lrT 'Sets loop
        
        If .Range("A" & i) = "" Then  'if range A and variable row is empty
            .Range("A" & i) = .Range("A" & i - 1) 'then copy the value in cell above and paste to it
        End If
        
        If .Range("B" & i) = "" Then  'if range B and variable row is empty
            .Range("B" & i) = .Range("B" & i - 1) 'then copy the value in cell above and paste to it
        End If
            
        If .Range("C" & i) = "" Then  'if range C and variable row is empty
            .Range("C" & i) = .Range("C" & i - 1) 'then copy the value in cell above and paste to it
        End If
        
        Next i
    End With
    
    w1.Select 'select current worksheet
    
Application.ScreenUpdating = True 'set screen to update again

ActiveWorkbook.RefreshAll 'refresh all data, e.g pivot tables


MsgBox "Complete"


End Sub




but if someone is able to see how i can lighten this macro up and make it more efficient, im all ears. im not sure if my chunk of code to delete the previous unpivotted table is the best way by using
Code: 
    w2.Visible = True
    w2.Select
        Rows("5:5").Select 'selects row 5, selects all rows down, and deletes to clear the table of old data
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
        w2.Visible = False
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Speeding up a VBA Macro & Code Cleanup
Replies
3
Views
487
Nordicrx8
N
S
  • Question Question
Help with Pivot Table Macro
Replies
0
Views
64
SCPbrito
S
Guinaba
  • Question Question
Tunning a VBA macro
Replies
1
Views
104
Skyybot
Skyybot
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
273
Jette3173
J
JohnZ1156
  • Solved
VBA Macro to print table rows from a start date to an end date.
Replies
4
Views
338
Joe4
Joe4

Forum statistics

Threads
1,224,820
Messages
6,181,160
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