What causes this VBA Code to take so long to run? - excel

Question

I am new using VBA and I've run into something that has been puzzling me: when I run a pivot on the following line of code it takes a really long time for it to finish when in reality it should not take that long. If anyone knows what the problem with it is or if you have some ways to make my code run more efficiently please let me know.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Dim ws1 As Worksheet
Dim wb1 As Workbook
Dim ws2 As Worksheet
Dim wb2 As Workbook
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet
Dim ws9 As Worksheet
Dim ws10 As Worksheet
Dim LastRow As Long
Dim LastRow1 As Long
Dim LastCol1 As Long
Dim PTable1 As PivotTable
Dim PCache1 As PivotCache
Dim PRange1 As Range
Set wb1 = ActiveWorkbook
Set ws1 = Sheets(1)
Set ws2 = Sheets.Add(After:=ActiveSheet)
Set ws3 = Sheets.Add(After:=ActiveSheet)
Set ws4 = Sheets.Add(After:=ActiveSheet)
Set ws5 = Sheets.Add(After:=ActiveSheet)
Set ws6 = Sheets.Add(After:=ActiveSheet)
Set ws7 = Sheets.Add(After:=ActiveSheet)
Set ws8 = Sheets.Add(After:=ActiveSheet)
Set ws9 = Sheets.Add(After:=ActiveSheet)
Set ws10 = Sheets.Add(After:=ActiveSheet)
ws2.Name = "Total"
ws3.Name = "01"
ws4.Name = "IM"
ws5.Name = "AMA"
ws6.Name = "TD"
ws7.Name = "PUP"
ws8.Name = "POS"
ws9.Name = "STG"
ws10.Name = "07"
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
With ws1
.Cells(1, 24) = "Bin"
.Cells(1, 25) = "UN"
.Range("A:Y").AutoFilter _
Field:=13, _
Criteria1:=">=1"
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("E1:M" & LastRow).Copy ws2.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=1", _
Operator:=xlOr, Criteria2:="=01DIST"
.Range("E1:M" & LastRow).Copy ws3.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:=Array("10", "20", "40", "80")
.Range("E1:M" & LastRow).Copy ws4.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=AMA"
.Range("E1:M" & LastRow).Copy ws5.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=TD"
.Range("E1:M" & LastRow).Copy ws6.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=STG"
.Range("E1:M" & LastRow).Copy ws9.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="7"
.Range("E1:M" & LastRow).Copy ws10.Range("A1")
End With
LastRow1 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
LastCol1 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange1 = ws2.Range("A1").CurrentRegion
Set PCache1 = ActiveWorkbook.PivotCaches.Create(xlDatabase, PRange1)
Set PTable1 = PCache1.CreatePivotTable(ws2.Cells(1, 10), "PivotTable1")
With PTable1.PivotFields("Part Number")
.Orientation = xlRowField
.Position = 1
End With
With PTable1.PivotFields("Inventory Value")
.Orientation = xlColumnField
.Position = 1
End With
With PTable1.PivotFields("Qty OH")
.Orientation = xlColumnField
.Position = 2
End With
PTable1.AddDataField ws2.PivotTables _
("PivotTable1").PivotFields("Qty OH"), "Sum of Qty OH", xlSum
PTable1.AddDataField ws2.PivotTables _
("PivotTable1").PivotFields("Inventory Value"), "Sum of Inventory Value", xlSum
End Sub

Answer 1

So I was able to find a way to make my pivot table run faster than before. I think it has something to do with the PTable1.PivotFields section of my previous code, my new code, which is longer now that I figured it out works like a charm.
Sub LiveERP_Test()
'
' LiveERP_Test Macro
'
' Keyboard Shortcut: Ctrl+q
'
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet
Dim ws9 As Worksheet
Dim ws10 As Worksheet
Dim LastRow As Long
Dim LastRow1 As Long
Dim LastCol1 As Long
Dim LastRow2 As Long
Dim LastCol2 As Long
Dim LastRow3 As Long
Dim LastCol3 As Long
Dim LastRow4 As Long
Dim LastCol4 As Long
Dim LastRow5 As Long
Dim LastCol5 As Long
Dim LastRow6 As Long
Dim LastCol6 As Long
Dim PTable1 As PivotTable
Dim PCache1 As PivotCache
Dim PRange1 As Range
Dim PTable2 As PivotTable
Dim PCache2 As PivotCache
Dim PRange2 As Range
Dim PTable3 As PivotTable
Dim PCache3 As PivotCache
Dim PRange3 As Range
Dim PTable4 As PivotTable
Dim PCache4 As PivotCache
Dim PRange4 As Range
Dim PTable5 As PivotTable
Dim PCache5 As PivotCache
Dim PRange5 As Range
Dim PTable6 As PivotTable
Dim PCache6 As PivotCache
Dim PRange6 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets.Add(After:=ActiveSheet)
Set ws3 = Sheets.Add(After:=ActiveSheet)
Set ws4 = Sheets.Add(After:=ActiveSheet)
Set ws5 = Sheets.Add(After:=ActiveSheet)
Set ws6 = Sheets.Add(After:=ActiveSheet)
Set ws7 = Sheets.Add(After:=ActiveSheet)
Set ws8 = Sheets.Add(After:=ActiveSheet)
Set ws9 = Sheets.Add(After:=ActiveSheet)
Set ws10 = Sheets.Add(After:=ActiveSheet)
ws2.Name = "Total"
ws3.Name = "01"
ws4.Name = "IM"
ws5.Name = "AMA"
ws6.Name = "TD"
ws7.Name = "PUP"
ws8.Name = "POS"
ws9.Name = "STG"
ws10.Name = "07"
With ws1
.Columns("W:W").EntireColumn.AutoFit
.Cells("1,24") = "Bin"
.Cells("1,25") = "UN"
.Range("A:Y").AutoFilter _
Field:=13, _
Criteria1:=">=1"
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("E1:M" & LastRow).Copy ws2.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=1", _
Operator:=xlOr, Criteria2:="=01DIST"
.Range("E1:M" & LastRow).Copy ws3.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:=Array("10", "20", "40", "80")
.Range("E1:M" & LastRow).Copy ws4.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=AMA"
.Range("E1:M" & LastRow).Copy ws5.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=TD"
.Range("E1:M" & LastRow).Copy ws6.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="=STG"
.Range("E1:M" & LastRow).Copy ws9.Range("A1")
.Range("A:Y").AutoFilter _
Field:=21, _
Criteria1:="7"
.Range("E1:M" & LastRow).Copy ws10.Range("A1")
.Range("U1:V" & LastRow).Copy ws10.Range("J1")
End With
LastRow1 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
LastCol1 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange1 = ws2.Range("A1").CurrentRegion
Set PCache1 = ActiveWorkbook.PivotCaches.Create(xlDatabase, PRange1)
Set PTable1 = PCache1.CreatePivotTable(ws2.Cells(1, 10), "PivotTable1")
With ws2.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ws2.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
With ws2.PivotTables("PivotTable1").PivotFields("Part Number")
.Orientation = xlRowField
.Position = 1
End With
PTable1.AddDataField ws2.PivotTables _
("PivotTable1").PivotFields("Qty OH"), "Sum of Qty OH", xlSum
PTable1.AddDataField ws2.PivotTables _
("PivotTable1").PivotFields("Inventory Value"), "Sum of Inventory Value", xlSum