Is my VBA script making the process too long?

[Christof]

Hi,

Apologies as I'm still a bit new to all this, but can someone have a look at my script and let me know if it's possible to optimise it a bit so that the data all refreshes much quicker.


As you can see it it refreshes 10 different pivot tables (the source data is about 130,000 rows and 60 columns).


I have put a bit in to put manual calcs on, then auto calcs when all the pivots have been updated.


Any advice would be greatly appreciated.


Many thanks

Chris

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range

    Set KeyCells = Range("C2:L8")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        Application.Calculation = xlManual

        Application.StatusBar = "Hi " & Application.UserName & "! Your report will be ready in a few seconds..."

        'Set the Variables to be used

        Dim pt1 As PivotTable
        Dim pt2 As PivotTable
        Dim pt3 As PivotTable
        Dim pt4 As PivotTable
        Dim pt5 As PivotTable
        Dim pt6 As PivotTable
        Dim pt7 As PivotTable
        Dim pt8 As PivotTable
        Dim pt9 As PivotTable
        Dim pt10 As PivotTable
        Dim pt11 As PivotTable
        Dim pt12 As PivotTable
        Dim pt13 As PivotTable
        Dim pt14 As PivotTable
        Dim pt15 As PivotTable
        Dim pt16 As PivotTable
        Dim Field1 As PivotField
        Dim Field2 As PivotField
        Dim Field3 As PivotField
        Dim Field4 As PivotField
        Dim Field5 As PivotField
        Dim Field6 As PivotField
        Dim Field7 As PivotField
        Dim Field8 As PivotField
        Dim Field9 As PivotField
        Dim Field10 As PivotField
        Dim Field11 As PivotField
        Dim Field12 As PivotField
        Dim Field13 As PivotField
        Dim Field14 As PivotField
        Dim Field15 As PivotField
        Dim Field16 As PivotField
        Dim Field17 As PivotField
        Dim Field18 As PivotField
        Dim Field19 As PivotField
        Dim Field20 As PivotField
        Dim Field21 As PivotField
        Dim Field22 As PivotField
        Dim Field23 As PivotField
        Dim Field24 As PivotField
        Dim Field25 As PivotField
        Dim Field26 As PivotField
        Dim Field27 As PivotField
        Dim Field28 As PivotField
        Dim Field29 As PivotField
        Dim Field30 As PivotField

       

        Dim NewCat1 As String
        Dim NewCat2 As String
        Dim NewCat3 As String
        Dim NewCat4 As String
        Dim pi As PivotItem


        'Here you amend to suit your data

        Set pt1 = Worksheets("Analysis Sheet").PivotTables("PivotTable1")
        Set pt2 = Worksheets("Analysis Sheet").PivotTables("PivotTable2")
        Set pt3 = Worksheets("Analysis Sheet").PivotTables("PivotTable3")
        Set pt4 = Worksheets("Analysis Sheet").PivotTables("PivotTable4")
        Set pt5 = Worksheets("Analysis Sheet").PivotTables("PivotTable5")
        Set pt6 = Worksheets("Analysis Sheet").PivotTables("PivotTable6")
        Set pt7 = Worksheets("Analysis Sheet").PivotTables("PivotTable7")
        Set pt8 = Worksheets("Analysis Sheet").PivotTables("PivotTable8")
        Set pt9 = Worksheets("Analysis Sheet").PivotTables("PivotTable9")
        Set pt10 = Worksheets("Analysis Sheet").PivotTables("PivotTable10")

       

        Set Field1 = pt1.PivotFields("Brand")
        Set Field2 = pt1.PivotFields("New Product Group")
        Set Field3 = pt1.PivotFields("Country")
        Set Field4 = pt1.PivotFields("Main Tour")
        Set Field5 = pt2.PivotFields("Brand")
        Set Field6 = pt2.PivotFields("New Product Group")
        Set Field7 = pt2.PivotFields("Country")
        Set Field8 = pt2.PivotFields("Main Tour")
        Set Field9 = pt3.PivotFields("Brand")
        Set Field10 = pt3.PivotFields("New Product Group")
        Set Field11 = pt3.PivotFields("Country")
        Set Field12 = pt4.PivotFields("Brand")
        Set Field13 = pt4.PivotFields("New Product Group")
        Set Field14 = pt4.PivotFields("Country")
        Set Field15 = pt5.PivotFields("Brand")
        Set Field16 = pt5.PivotFields("New Product Group")
        Set Field17 = pt5.PivotFields("Country")
        Set Field18 = pt6.PivotFields("Brand")
        Set Field19 = pt6.PivotFields("New Product Group")
        Set Field20 = pt6.PivotFields("Country")
        Set Field21 = pt7.PivotFields("Brand")
        Set Field22 = pt8.PivotFields("Brand")
        Set Field23 = pt8.PivotFields("New Product Group")
        Set Field24 = pt9.PivotFields("Brand")
        Set Field25 = pt9.PivotFields("New Product Group")
        Set Field26 = pt9.PivotFields("Country")
        Set Field27 = pt10.PivotFields("Brand")
        Set Field28 = pt10.PivotFields("New Product Group")
        Set Field29 = pt10.PivotFields("Country")
        Set Field30 = pt10.PivotFields("Main Tour")
     

       
        NewCat1 = Worksheets("Analysis Sheet").Range("C2").Value
        NewCat2 = Worksheets("Analysis Sheet").Range("C4").Value
        NewCat3 = Worksheets("Analysis Sheet").Range("C6").Value
        NewCat4 = Worksheets("Analysis Sheet").Range("C8").Value


            With pt1
                Field1.ClearAllFilters
                Field1.CurrentPage = NewCat1
                Field2.ClearAllFilters
                Field2.CurrentPage = NewCat2
                Field3.ClearAllFilters
                Field3.CurrentPage = NewCat3
                Field4.ClearAllFilters
                Field4.CurrentPage = NewCat4
                pt1.RefreshTable
            End With

           

            With pt2
                Field5.ClearAllFilters
                Field5.CurrentPage = NewCat1
                Field6.ClearAllFilters
                Field6.CurrentPage = NewCat2
                Field7.ClearAllFilters
                Field7.CurrentPage = NewCat3
                Field8.ClearAllFilters
                Field8.CurrentPage = NewCat4
                pt2.RefreshTable
            End With


            With pt3
                Field9.ClearAllFilters
                Field9.CurrentPage = NewCat
                Field10.ClearAllFilters
                Field10.CurrentPage = NewCat2
                Field11.ClearAllFilters
                Field11.CurrentPage = NewCat3
                pt3.RefreshTable

            End With


            With pt4

                Field12.ClearAllFilters
                Field12.CurrentPage = NewCat1
                Field13.ClearAllFilters
                Field13.CurrentPage = NewCat2
                Field14.ClearAllFilters
                Field14.CurrentPage = NewCat3
                pt4.RefreshTable
            End With


            With pt5
                Field15.ClearAllFilters
                Field15.CurrentPage = NewCat1
                Field16.ClearAllFilters
                Field16.CurrentPage = NewCat2
                Field17.ClearAllFilters
                Field17.CurrentPage = NewCat3
                pt5.RefreshTable
            End With


            With pt6

                Field18.ClearAllFilters
                Field18.CurrentPage = NewCat1
                Field19.ClearAllFilters
                Field19.CurrentPage = NewCat2
                Field20.ClearAllFilters
                Field20.CurrentPage = NewCat3
                pt6.RefreshTable

            End With



            With pt7

                Field21.ClearAllFilters

                Field21.CurrentPage = NewCat1

                pt7.RefreshTable

            End With



            With pt8

                Field22.ClearAllFilters

                Field22.CurrentPage = NewCat1

                Field23.ClearAllFilters

                Field23.CurrentPage = NewCat2

                pt8.RefreshTable

            End With


            With pt9
                Field24.ClearAllFilters
                Field24.CurrentPage = NewCat1
                Field25.ClearAllFilters
                Field25.CurrentPage = NewCat2
                Field26.ClearAllFilters
                Field26.CurrentPage = NewCat3
                pt9.RefreshTable
            End With


            With pt10

                Field27.ClearAllFilters
                Field27.CurrentPage = NewCat1
                Field28.ClearAllFilters
                Field28.CurrentPage = NewCat2
                Field29.ClearAllFilters
                Field29.CurrentPage = NewCat3
                Field30.ClearAllFilters
                Field30.CurrentPage = NewCat4
                pt10.RefreshTable

            End With




        Application.Calculation = xlAutomatic

        Application.StatusBar = "All done!"


   End If

End Sub

 

[vletm]

Christof
You could test something like this ...

Sub Do_It()

'   Your if formula starts from here ...
   
        With Application
            cm = .Calculation
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
   
' Your code here

        With Application
            .Calculation = cm
            .EnableEvents = True
            .ScreenUpdating = True
        End With
       
'   Your if formulas ends here
End Sub

 

[Christof]

Thank you, that has made a little bit of a difference.

Is the rest of my script okay? It's not written in an inefficient way that makes the process longer than it should be or anything?

Cheers
Chris

Christof
You could test something like this ...

Sub Do_It()

'   Your if formula starts from here ...
  
        With Application
            cm = .Calculation
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
  
' Your code here

        With Application
            .Calculation = cm
            .EnableEvents = True
            .ScreenUpdating = True
        End With
      
'   Your if formulas ends here
End Sub

 

[chirayu]

I just shortened the code

Private Sub Worksheet_Change(ByVal Target As Range)

'Start
'-----
Dim KeyCells As Range
Set KeyCells = Range("C2:L8")

'Check Keycells are not blank
'-----------------------------
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

    Application.Calculation = xlManual

    Application.StatusBar = "Hi " & Application.UserName & "! Your report will be ready in a few seconds..."

    'Define Variables
    '----------------
    Dim PVT As PivotTable 'Loop through Pivots
    Dim NewCat1 As String
    Dim NewCat2 As String
    Dim NewCat3 As String
    Dim NewCat4 As String
    Dim i As Integer 'Loop through Pivots
   
    'Add fields to Pivots
    '--------------------
    i = 0
    For Each PVT In Worksheets("Analysis Sheet")
        i = i + 1
       
        If i = 1 Or i = 2 Or i = 10 Then 'Pivots 1,2,10
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
                .PivotFields ("Country")
                .PivotFields ("Main Tour")
            End With
       
        ElseIf i = 3 Or i = 4 Or i = 5 Or i = 6 Or i = 9 Then 'Pivots 3,4,5,6,9
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
                .PivotFields ("Country")
            End With
       
        ElseIf i = 7 Then 'Pivot 7
            With PVT
                .PivotFields ("Brand")
            End With
       
        ElseIf i = 8 Then 'Pivot 8
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
            End With
           
        Else
        End If
   
    Next PVT
   
   
    'Clear filters and  add CAT
    '--------------------------
    With Worksheets("Analysis Sheet")
        NewCat1 = .Range("C2").Value
        NewCat2 = .Range("C4").Value
        NewCat3 = .Range("C6").Value
        NewCat4 = .Range("C8").Value
    End With
   
    i = 0
    For Each PVT In Worksheets("Analysis Sheet")
        i = i + 1
   
        If i = 1 Or i = 2 Or i = 10 Then 'Pivots 1,2,10
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
                With .PivotFields("Country")
                    .ClearAllFilters
                    .CurrentPage = NewCat3
                End With
                With .PivotFields("Main Tour")
                    .ClearAllFilters
                    .CurrentPage = NewCat4
                End With
            End With
           
        ElseIf i = 3 Or i = 4 Or i = 5 Or i = 6 Or i = 9 Then 'Pivots 3,4,5,6,9
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
                With .PivotFields("Country")
                    .ClearAllFilters
                    .CurrentPage = NewCat3
                End With
            End With
           
        ElseIf i = 7 Then 'Pivot 7
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
            End With
           
        ElseIf i = 8 Then 'Pivot 8
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
            End With
           
        Else
        End If
            .RefreshTable
           
    Next PVT
   
    'Finish
    '------
    Application.Calculation = xlAutomatic
    Application.StatusBar = "All done!"

Else
End If

End Sub

 

[vletm]

Christof
My sample should run it quicker (#2 Reply).
But as above (#4), the code could write shorter too.
There were 'same looking parts many times'.
But ... write code, which You can read.

 

[Christof]

Thank you, this looks really promising... however when I did it i got the following error...

I just shortened the code

 

[AlanSidman]

crossposted: https://www.mrexcel.com/forum/excel-questions/1077419-my-vba-script-making-process-too-long.html

 

[chirayu]

try changing .RefreshTable to .Update

 

[Christof]

Nah, sorry, same error message

try changing .RefreshTable to .Update

 

[Christof]

Is that frowned upon?
Sorry, I'm new to these forums too.

crossposted: https://www.mrexcel.com/forum/excel-questions/1077419-my-vba-script-making-process-too-long.html

 

[vletm]

Christof
So, You gotta read or reread:

https://chandoo.org/forum/threads/site-rules-new-users-please-read.294/​

especially from ...

• Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.

 

[Christof]

I'm really sorry

I'm trying to remove my post from MrExcel.

I wont do it again

Christof
So, You gotta read or reread:

https://chandoo.org/forum/threads/site-rules-new-users-please-read.294/​

especially from ...

• 
  
  
  • Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.

 

[chirayu]

Can you povide a sample file so I can test and check

 

[Christof]

Can you povide a sample file so I can test and check

Sent you a link

 

[chirayu]

try this. Also noticed you have more pivots in the sheet that arent being updated by the macro. any reason?

Private Sub Worksheet_Change(ByVal Target As Range)

'Start
'-----
Dim KeyCells As Range
Set KeyCells = Range("C2:L8")

'Check Keycells are not blank
'-----------------------------
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
   
    Application.Calculation = xlManual
   
    Application.StatusBar = "Hi " & Application.UserName & "! Your report will be ready in a few seconds..."
   
    'Define Variables
    '----------------
    Dim PVT As PivotTable 'Loop through Pivots
    Dim NewCat1 As String
    Dim NewCat2 As String
    Dim NewCat3 As String
    Dim NewCat4 As String
    Dim i As Integer 'Loop through Pivots
 
    'Add fields to Pivots
    '--------------------
    i = 0
    For Each PVT In Worksheets("Analysis Sheet").PivotTables
        i = i + 1
       
        If i = 1 Or i = 2 Or i = 10 Then 'Pivots 1,2,10
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
                .PivotFields ("Country")
                .PivotFields ("Main Tour")
            End With
       
        ElseIf i = 3 Or i = 4 Or i = 5 Or i = 6 Or i = 9 Then 'Pivots 3,4,5,6,9
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
                .PivotFields ("Country")
            End With
       
        ElseIf i = 7 Then 'Pivot 7
            With PVT
                .PivotFields ("Brand")
            End With
       
        ElseIf i = 8 Then 'Pivot 8
            With PVT
                .PivotFields ("Brand")
                .PivotFields ("New Product Group")
            End With
           
        Else
        End If
   
    Next PVT
   
   
    'Clear filters and  add CAT
    '--------------------------
    With Worksheets("Analysis Sheet")
        NewCat1 = .Range("C2").Value
        NewCat2 = .Range("C4").Value
        NewCat3 = .Range("C6").Value
        NewCat4 = .Range("C8").Value
    End With
   
    i = 0
    For Each PVT In Worksheets("Analysis Sheet").PivotTables
        i = i + 1
   
        If i = 1 Or i = 2 Or i = 10 Then 'Pivots 1,2,10
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
                With .PivotFields("Country")
                    .ClearAllFilters
                    .CurrentPage = NewCat3
                End With
                With .PivotFields("Main Tour")
                    .ClearAllFilters
                    .CurrentPage = NewCat4
                End With
            End With
           
        ElseIf i = 3 Or i = 4 Or i = 5 Or i = 6 Or i = 9 Then 'Pivots 3,4,5,6,9
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
                With .PivotFields("Country")
                    .ClearAllFilters
                    .CurrentPage = NewCat3
                End With
            End With
           
        ElseIf i = 7 Then 'Pivot 7
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
            End With
           
        ElseIf i = 8 Then 'Pivot 8
            With PVT
                With .PivotFields("Brand")
                    .ClearAllFilters
                    .CurrentPage = NewCat1
                End With
                With .PivotFields("New Product Group")
                    .ClearAllFilters
                    .CurrentPage = NewCat2
                End With
            End With
           
        Else
        End If
            PVT.RefreshTable
           
    Next PVT
   
    'Finish
    '------
    Application.Calculation = xlAutomatic
    Application.StatusBar = "All done!"

Else
End If

End Sub

 

[Christof]

Only because the forum wouldnt allow me to exceed 10,000 characters.. so i trimmed some of my script out..lol

I figured if i can get it sped up for 10 pivots, i can do 16.

 

[chirayu]

assuming then that u can probably edit my code to add the other 6 in ?

 

[Christof]

Thank you so much for your help today.. this seems like a much cleaner way to code