Thread: Faster code for selecting dates from conditions, in pivot table

Hi,

I have a common issue with selecting the wanted items (dates) in a pivot table. The condition for selection is simple: select all dates between a start-date and an end-date which these two dates are coming from cetain cells on an another sheet.

I have the following, probably well-known procedure: For each pivot item in the pivot table-> if the item has value later/earlier than enddate/startdate then don't select the item, and otherwise select it:

Sub showitem()
      
    Worksheets("pivot").PivotTables("Pivottable1").ClearAllFilters
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim startdate As Date
    Dim enddate As Date
    
    Set pt = Worksheets("pivot").PivotTables("Pivottable1")
    Set pf = pt.PivotFields("Date")

    startdate = CDate(Worksheets("Master").Range("D3"))
    enddate = CDate(Worksheets("Master").Range("E3"))
    
    On Error Resume Next 
    'Worksheets("pivot").Activate
    
   With pf
            For Each pi In pf.PivotItems
            If CDate(pi.Value) < startdate Or CDate(pi.Value) > enddate Then
                pi.Visible = False
               Else
                pi.Visible = True
               End If
        Next pi
               
    End With
    
End Sub

This works very fine! But i wondered if it could be made faster, because I actually have to wait almost 20 seconds to run the whole for-statement. Because the code applies the condition at every single pivot-item in the pivot-field "Date" and that's not cool I think.

I wondered if one can make two bounds: upper=enddate and lower=startdate and then only let the for-loop run for the items in between and then say that all the rest of date-items should not be selected.

Does any have an idea how to write such a code? or any other idea is very welcomed! Thanks in advance!

You could try:

Sub showitem
Application.ScreenUpdating = False
Application.Calculation=xlCalculationManual
:
your code
:
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Regards

You're welcome.