unpivotting a table with macro

[Mechixx]

Hello everyone,

So i had been directed to this thread here:

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:

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

Dept.	Part #	Op #	Type of Item	Item Code	Stock #	# of Corners	# of Pieces per Corner	QTY/January	QTY/February	QTY/March	QTY/April	QTY/May	QTY/June	QTY/July	QTY/August	QTY/September	QTY/October	QTY/November	QTY/December
Auto.	S123	10	Insert	CNMG 432 PM 4325	16392	4	250	36	32	28	0	0	32	0	0	0	40	0	0
Auto.	S124	20	Insert	WNMG 432-WMX 4215	17339	4	150	60	53	47	0	0	53	0	0	0	0	0	0

<tbody>
</tbody>

and turn it into this:

Stock #	Item Code	Part #	Date	Sum of Month	Min of Month	Max of Month
16392	CNMG 432 PM 4325	S123	Jan	36
16392	CNMG 432 PM 4325	S123	Feb	32
16392	CNMG 432 PM 4325	S123	Mar	28
16392	CNMG 432 PM 4325	S123	Apr	0
16392	CNMG 432 PM 4325	S123	May	0
16392	CNMG 432 PM 4325	S123	Jun	32
16392	CNMG 432 PM 4325	S123	Jul	0
16392	CNMG 432 PM 4325	S123	Aug	0
16392	CNMG 432 PM 4325	S123	Sep	0
16392	CNMG 432 PM 4325	S123	Oct	40
16392	CNMG 432 PM 4325	S123	Nov	0
16392	CNMG 432 PM 4325	S123	Dec	0
17339	WNMG 432-WMX 4215	S124	Jan	60
17339	WNMG 432-WMX 4215	S124	Feb	53
17339	WNMG 432-WMX 4215	S124	Mar	47
17339	WNMG 432-WMX 4215	S124	Apr	0
17339	WNMG 432-WMX 4215	S124	May	0
17339	WNMG 432-WMX 4215	S124	Jun	53
17339	WNMG 432-WMX 4215	S124	Jul	0
17339	WNMG 432-WMX 4215	S124	Aug	0
17339	WNMG 432-WMX 4215	S124	Sep	0
17339	WNMG 432-WMX 4215	S124	Oct	0
17339	WNMG 432-WMX 4215	S124	Nov	0
17339	WNMG 432-WMX 4215	S124	Dec	0

<tbody>
</tbody>

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

 

[Mechixx]

** 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):

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

 

[Mechixx]

**Update
Figured out what i had to change to make everything work!

here's the code if anyone is interested:

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

    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