Macro to automatically select the most recent date in a pivot table filter drop down

Question

I have a report that is refreshed each week automatically, and then I have a number of macros that run that do various things. Everything currently works fine, however, I want to write a macro that automatically selects the most recent date in a pivot table. At present, I have the following code:

Sub RefreshPivot()
'
' RefreshPivot Macro
'

'
    Sheets("Pivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
        = "22/08/2017"
End Sub

The date "22/08/2017" is currently the most recent date, but if I run the report next week, the above macro is going to select the 22/08/2017 every time. Is there a quick piece of code that always selects the most recent date in the pivot filter?

Any help would be most welcome.

edit:

So, I've attempted a different solution, that uses a cell reference in my report that contains the most recent date. I use this date to set the filter criteria, and then the for loop goes through the pivot data and sets each value to blank until it finds a match:

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period


Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As String
Dim pi As PivotItem

    'Set the variables
    sSheetName = "Pivot"
    sPivotName = "PivotTable1"
    sFieldName = "ExtractDate"
    'sFilterCrit = "22/08/2017" --most recent date
    sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

    With ThisWorkbook.Worksheets(sSheetName).PivotTables(sPivotName).PivotFields(sFieldName)
        'Clear all filter of the pivotfield
        .ClearAllFilters

        'Loop through pivot items of the pivot field
        'Hide or filter out items that do not match the criteria
        For Each pi In .PivotItems
            If pi.Name <> sFilterCrit Then
                pi.Visible = False
            End If
        Next pi

    End With

End Sub

However, when I run this, I get the following error:

Run-time error '1004': Unable to set the Visible property of the PivotItem class.

Is anyone able to assist me?

Subodh Tiwari sktneer Subodh Tiwari sktneer · Accepted Answer · 2017-08-23T12:10:53

Please give this a try...

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters


For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

If you are not sure whether your criteria date is available in pivot filter items or not, you may try something like this.

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim dict
'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters

Set dict = CreateObject("Scripting.Dictionary")
For Each pi In pf.PivotItems
    dict.Item(CDbl(DateValue(pi))) = ""
Next pi

If Not dict.exists(sFilterCrit) Then
    MsgBox "The criteria date is missing in Pivot Filter Items.", vbExclamation
    Exit Sub
End If

For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

Macro to automatically select the most recent date in a pivot table filter drop down

2 Answers