huddsterrier
New Member
- Joined
- May 30, 2014
- Messages
- 12
Hi,
I have just made a macro to automate a few tasks, it contains 3 pivot tables 2 of which work fine, the 3rd one errors everytime.
It also slows down just before hand, doing it manually doesn't take long. I am okay at making and doing slight adjustmenst but not sure what if anything I could take out to speed it up, but know it doesn't have to be this long and I have no idea why the pivot crashes.
Could someone please have a look and see if I have done anything wrong.
Sub Voluplift()
'
' attempt2 Macro
'
'
Sheets("TP").Select
Range("O1").Select
ActiveCell.FormulaR1C1 = "RDC/STORE"
Range("Q1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"TP!R1C1:R1048576C15", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="TP!R1C17", TableName:="PivotTable4", DefaultVersion:= _
xlPivotTableVersion15
Sheets("TP").Select
Cells(1, 17).Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("RDC/STORE")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("UPC")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Case Qty"), "Count of Case Qty", xlCount
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of Case Qty")
.Caption = "Sum of Case Qty"
.Function = xlSum
End With
Sheets("FV").Select
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "UPC"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[1],8))"
Dim LRa As Long
LRa = Range("D" & Rows.Count).End(xlUp).Row
Range("E2").AutoFill Destination:=Range("E2:E" & LRa)
Range("R1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"FV!R1C1:R1048576C16", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="FV!R1C18", TableName:="PivotTable5", DefaultVersion:= _
xlPivotTableVersion15
Sheets("FV").Select
Cells(1, 18).Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields("DEPOT")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("UPC")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("ALLOCATED_CASES"), "Count of ALLOCATED_CASES", _
xlCount
With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
"Count of ALLOCATED_CASES")
.Caption = "Sum of ALLOCATED_CASES"
.Function = xlSum
End With
Sheets("Master SKU").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "UPC"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[1],8))"
Dim LRb As Long
LRb = Range("c" & Rows.Count).End(xlUp).Row
Range("b2").AutoFill Destination:=Range("b2:b" & LRb)
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "SKU"
Range("D1").Select
ActiveCell.FormulaR1C1 = "CAT"
Range("E1").Select
ActiveCell.FormulaR1C1 = "FV"
Range("F1").Select
ActiveCell.FormulaR1C1 = "TP"
Range("G1").Select
ActiveCell.FormulaR1C1 = "'+/-"
Columns("A:G").Select
ActiveSheet.Range("$A:$G").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, _
6, 7), Header:=xlYes
ActiveWorkbook.Worksheets("Master SKU").sort.SortFields.Clear
ActiveWorkbook.Worksheets("Master SKU").sort.SortFields.Add Key:=Range( _
"D:D"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Master SKU").sort
.SetRange Range("A:G")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],FV!C[13]:C[14],2,0)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],FV!C[13]:C[14],2,0),0)"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-5],TP!C[11]:C[12],2,0),0)"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Dim LRc As Long
LRc = Range("c" & Rows.Count).End(xlUp).Row
Range("E2:G2").AutoFill Destination:=Range("e2:g" & LRc)
Cells.Select
Selection.Copy
Selection.pastespecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("1:1").Select
'Slows down around this point
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$55287").AutoFilter Field:=5, Criteria1:="0"
ActiveSheet.Range("$A$1:$L$55287").AutoFilter Field:=6, Criteria1:="0"
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A:$P").AutoFilter Field:=5
ActiveSheet.Range("$A:$P").AutoFilter Field:=6
Columns("A:G").Select
'Debug shows it stopping here
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Master SKU!R1C1:R1048576C7", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Master SKU!R3C11", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion15
Sheets("Master SKU").Select
Cells(3, 11).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("FV"), "Count of FV", xlCount
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("TP"), "Count of TP", xlCount
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("+/-"), "Count of +/-", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of FV")
.Caption = "Sum of FV"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of TP")
.Caption = "Sum of TP"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of +/-")
.Caption = "Sum of +/-"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("CAT")
.Orientation = xlRowField
.Position = 1
End With
End Sub
I have just made a macro to automate a few tasks, it contains 3 pivot tables 2 of which work fine, the 3rd one errors everytime.
It also slows down just before hand, doing it manually doesn't take long. I am okay at making and doing slight adjustmenst but not sure what if anything I could take out to speed it up, but know it doesn't have to be this long and I have no idea why the pivot crashes.
Could someone please have a look and see if I have done anything wrong.
Sub Voluplift()
'
' attempt2 Macro
'
'
Sheets("TP").Select
Range("O1").Select
ActiveCell.FormulaR1C1 = "RDC/STORE"
Range("Q1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"TP!R1C1:R1048576C15", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="TP!R1C17", TableName:="PivotTable4", DefaultVersion:= _
xlPivotTableVersion15
Sheets("TP").Select
Cells(1, 17).Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("RDC/STORE")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("UPC")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Case Qty"), "Count of Case Qty", xlCount
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of Case Qty")
.Caption = "Sum of Case Qty"
.Function = xlSum
End With
Sheets("FV").Select
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "UPC"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[1],8))"
Dim LRa As Long
LRa = Range("D" & Rows.Count).End(xlUp).Row
Range("E2").AutoFill Destination:=Range("E2:E" & LRa)
Range("R1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"FV!R1C1:R1048576C16", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="FV!R1C18", TableName:="PivotTable5", DefaultVersion:= _
xlPivotTableVersion15
Sheets("FV").Select
Cells(1, 18).Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields("DEPOT")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("UPC")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("ALLOCATED_CASES"), "Count of ALLOCATED_CASES", _
xlCount
With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
"Count of ALLOCATED_CASES")
.Caption = "Sum of ALLOCATED_CASES"
.Function = xlSum
End With
Sheets("Master SKU").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "UPC"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[1],8))"
Dim LRb As Long
LRb = Range("c" & Rows.Count).End(xlUp).Row
Range("b2").AutoFill Destination:=Range("b2:b" & LRb)
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "SKU"
Range("D1").Select
ActiveCell.FormulaR1C1 = "CAT"
Range("E1").Select
ActiveCell.FormulaR1C1 = "FV"
Range("F1").Select
ActiveCell.FormulaR1C1 = "TP"
Range("G1").Select
ActiveCell.FormulaR1C1 = "'+/-"
Columns("A:G").Select
ActiveSheet.Range("$A:$G").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, _
6, 7), Header:=xlYes
ActiveWorkbook.Worksheets("Master SKU").sort.SortFields.Clear
ActiveWorkbook.Worksheets("Master SKU").sort.SortFields.Add Key:=Range( _
"D:D"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Master SKU").sort
.SetRange Range("A:G")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],FV!C[13]:C[14],2,0)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],FV!C[13]:C[14],2,0),0)"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-5],TP!C[11]:C[12],2,0),0)"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Dim LRc As Long
LRc = Range("c" & Rows.Count).End(xlUp).Row
Range("E2:G2").AutoFill Destination:=Range("e2:g" & LRc)
Cells.Select
Selection.Copy
Selection.pastespecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("1:1").Select
'Slows down around this point
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$55287").AutoFilter Field:=5, Criteria1:="0"
ActiveSheet.Range("$A$1:$L$55287").AutoFilter Field:=6, Criteria1:="0"
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A:$P").AutoFilter Field:=5
ActiveSheet.Range("$A:$P").AutoFilter Field:=6
Columns("A:G").Select
'Debug shows it stopping here
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Master SKU!R1C1:R1048576C7", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Master SKU!R3C11", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion15
Sheets("Master SKU").Select
Cells(3, 11).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("FV"), "Count of FV", xlCount
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("TP"), "Count of TP", xlCount
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("+/-"), "Count of +/-", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of FV")
.Caption = "Sum of FV"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of TP")
.Caption = "Sum of TP"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of +/-")
.Caption = "Sum of +/-"
.Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("CAT")
.Orientation = xlRowField
.Position = 1
End With
End Sub