1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Is my VBA script making the process too long?

Discussion in 'VBA Macros' started by Christof, Nov 13, 2018.

  1. Christof

    Christof Member

    Messages:
    40
    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




    Code (vb):



    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


     
  2. vletm

    vletm Excel Ninja

    Messages:
    4,415
    Christof
    You could test something like this ...

    Code (vb):

    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
     
    Chirag R Raval likes this.
  3. Christof

    Christof Member

    Messages:
    40
    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





  4. chirayu

    chirayu Well-Known Member

    Messages:
    946
    I just shortened the code

    Code (vb):
    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
    Chirag R Raval likes this.
  5. vletm

    vletm Excel Ninja

    Messages:
    4,415
    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.
  6. Christof

    Christof Member

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

    upload_2018-11-13_10-50-20.png

  7. AlanSidman

    AlanSidman Active Member

    Messages:
    413
  8. chirayu

    chirayu Well-Known Member

    Messages:
    946
    try changing .RefreshTable to .Update
  9. Christof

    Christof Member

    Messages:
    40
    Nah, sorry, same error message

  10. Christof

    Christof Member

    Messages:
    40
  11. vletm

    vletm Excel Ninja

    Messages:
    4,415
  12. Christof

    Christof Member

    Messages:
    40
    I'm really sorry :(

    I'm trying to remove my post from MrExcel.

    I wont do it again


  13. chirayu

    chirayu Well-Known Member

    Messages:
    946
    Can you povide a sample file so I can test and check
  14. Christof

    Christof Member

    Messages:
    40
    Sent you a link :)
  15. chirayu

    chirayu Well-Known Member

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

    Code (vb):
    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
  16. Christof

    Christof Member

    Messages:
    40
    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.
  17. chirayu

    chirayu Well-Known Member

    Messages:
    946
    assuming then that u can probably edit my code to add the other 6 in ?
  18. Christof

    Christof Member

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

Share This Page