Macro Pivot error and speed up

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
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

huddsterrier

New Member
Joined
May 30, 2014
Messages
12
I have sorted out the pivot table error, I would appreciate if someone could help me speed it up though.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,118
Messages
5,640,216
Members
417,131
Latest member
Seanr19871

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
Top