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

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

Pivot tables are a bit slow. But, in general, [take a look here](https://stackoverflow.com/a/49514930/5448626) and speed up the code a bit. `Application.ScreenUpdating = False` written after the second line of your code will do miracles. — Vityata, Dec 11 '19 at 22:25
@Vityata its weird because another code for a report I have runs really fast (its also longer than this one) so its very confusing to me why this would take longer than the other. Could it be like this because of all the new sheets i have added to this since for the other report I don't have it make new sheets? — Ematics, Dec 12 '19 at 18:09
"Could it be like this because of all the new sheets i have added?" - 10 worksheets are not that many and there is no data in them. So, I would say 99% "no". I would still go with the pivots, they are slow, depending on the amount on data with them. — Vityata, Dec 12 '19 at 18:54
@Vityata Ok, for my last question for you then would be, would it be better to have the record macro be my macro because it appears to be faster than what I currently have here in terms of how long it takes to finish running the macro? For instance for the auto record macro I have it takes 45 sec to finish doing everything I need, but just for this first pivot on the above code it takes a few minutes. — Ematics, Dec 12 '19 at 19:07
the recorded macro should be way slower, unless it does not make less actions than the VBA code (or the VBA code is doing some useless actions).Thus, I guess the recorded macro, taking 45 seconds does way less than the code. What I can advise is to take a good look at what the recorded macro does and possibly even to go line by line with F8 and then to improve it. — Vityata, Dec 12 '19 at 19:48
@Vityata Hey thats what I ended up doing and copying some stuff over and deleting some stuff as well, I'll post my new code incase anyone else needs help with something like this. Thanks for all of your help! — Ematics, Dec 12 '19 at 19:54

score 0 · Accepted Answer · answered Dec 12 '19 at 19:56

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

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

1 Answers1