Reputation: 334
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?
Upvotes: 0
Views: 4869
Reputation: 9976
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
Upvotes: 2
Reputation: 334
For anybody that is interested or may need to do this in future, here is the solution that I came up with:
Sub RefreshPivot()
'
' RefreshPivot Macro
'
'
Sheets("Pivot").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
= ThisWorkbook.Worksheets("Pivot").Range("C4").Value
End Sub
The value in cell C4 is simply the most recent date. This works perfectly now.
Upvotes: 1