Is it possible to make this code faster?

MarkCBB

Active Member
Joined
Apr 12, 2010
Messages
497
HI there,

I am using this code to filter every PivotTable on a worksheet by an item that I select from a ComboBox, but the code takes some time to run, and there are only 15 pivot Tables and there are 30 Items.

Code:
Private Sub ComboBox1_Click()
Dim MyReport As Worksheet
Dim i As Integer
Dim PTCount As Integer
Dim MyWord As String

i = 0
Set MyReport = Sheets("Report_QSR")
MyReport.Range("A2").Value = ComboBox1.Value
PTCount = MyReport.PivotTables.Count
MyWord = MyReport.Range("A2").Value

With Application
    .EnableAnimations = False
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
End With

Do
i = i + 1
    With MyReport.PivotTables(i).PivotFields("CHANNEL")
        On Error Resume Next
            .PivotItems(MyWord).Visible = True
        On Error GoTo 0
            For Each Pi In .PivotItems
        On Error Resume Next
            If Pi.Name <> MyWord Then Pi.Visible = False
        On Error GoTo 0
            Next Pi
    End With
    Application.StatusBar = i & " Number of reports updated"
Loop Until i = PTCount

With Application
    .StatusBar = ""
    .EnableAnimations = True
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub
Private Sub ComboBox1_DropButt*******()
Dim i As Integer
ComboBox1.Clear
i = 6
Do
i = i + 1
ComboBox1.AddItem Sheets("REPORT_QSR").Range("H" & i).Value
Loop Until Range("H" & i).Offset(1, 0).Value = ""
End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Is this any faster:
Code:
Private Sub ComboBox1_Click()
   Dim MyReport          As Worksheet
   Dim i                 As Integer
   Dim PTCount           As Integer
   Dim MyWord            As String
   Dim pt                As PivotTable
   Dim calc              As Excel.XlCalculation
   i = 0
   Set MyReport = Sheets("Report_QSR")
   MyReport.Range("A2").Value = ComboBox1.Value
   PTCount = MyReport.PivotTables.Count
   MyWord = MyReport.Range("A2").Value

   With Application
      calc = .Calculation
      .Calculation = xlCalculationManual
      .EnableAnimations = False
      .DisplayAlerts = False
      .ScreenUpdating = False
      .EnableEvents = False
   End With

   For Each pt In MyReport.PivotTables
      With pt
         .ManualUpdate = True
         With .PivotFields("CHANNEL")
            On Error Resume Next
            .PivotItems(MyWord).Visible = True
            For Each Pi In .PivotItems
               If Pi.Name <> MyWord Then Pi.Visible = False
            Next Pi
            On Error GoTo 0
         End With
         .ManualUpdate = False
      End With
      i = i + 1
      Application.StatusBar = i & " Number of reports updated"
   Next pt

   With Application
      .StatusBar = ""
      .EnableAnimations = True
      .DisplayAlerts = True
      .EnableEvents = True
      .Calculation = calc
      .ScreenUpdating = True
   End With
End Sub
 
Upvote 0
WOW!!!! so much faster!

the code used to take 2mins to run, now it takes 4 seconds.

thank you so much, that is awesome!
 
Upvote 0
It's to store (and later restore) the original calculation setting - you might have had it on something other than automatic for a reason.
 
Upvote 0

Forum statistics

Threads
1,223,517
Messages
6,172,795
Members
452,480
Latest member
kareem996

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
Back
Top