VBA Filter error - excel

I have a filter field called week_of_year (1,2,3,4,5,6,7,8....), another pivot field year(2012,2013,2014), the vba code belows filter on the current week and year of 2014/2015 and hide everything else. But the problem is the code loops each record and runs slow when it comes to big pivot table. Im trying on a new code but encountering some error.
Sub datefilter()
Dim PvtTbl As PivotTable
Set PvtTbl = Worksheets("LO").PivotTables("PivotTable3")
Dim dd As Integer
dd = Format(Date, "ww")
Dim pf As PivotField
Dim pf1 As PivotField
Dim PI As PivotItem
Set pf =
Worksheets("LO").PivotTables("PivotTable3").PivotFields("week_of_year")
Set pf1 =
Worksheets("LO").PivotTables("PivotTable3").PivotFields("year")
PvtTbl.ClearAllFilters
For Each PI In pf.PivotItems
If PI.Name = CStr(dd) Then
PI.Visible = True
Else
PI.Visible = False
End If
Next
For Each PI In pf1.PivotItems
If PI.Name = "2014" Or PI.Name = "2015" Then
PI.Visible = True
Else
PI.Visible = False
End If
Next
End Sub
New code that I develop is:
Sub datefilter1()
Dim PvtTbl As PivotTable
Set PvtTbl = Worksheets("LO").PivotTables("PivotTable3")
Dim dd As Integer
dd = Format(Date, "ww")
Dim pf As PivotField
Set pf =
Worksheets("LO").PivotTables("PivotTable3").PivotFields("week_of_year")
pf.PivotFilters.Add2 xlValueEquals, 3
End Sub
The code failed at
pf.PivotFilters.Add2 xlValueEquals, CStr(dd)
I also tried:
pf.PivotFilters.Add2 Type:= xlValueEquals, Value1 := CStr(dd)
The error is Invalid procedure call or argument.Any idea How I can fix this error?????
Any faster way to filter on multiple filter criteria? Thanks!

If you only want to filter on one value, drag the field of interest to the Report Filter pane, then you can do this very quickly without looping using the following code:
Sub FilterOnWeek()
Dim pt As PivotTable
Dim pf As PivotField
Set pt = Worksheets("LO").PivotTables("PivotTable3")
Set pf = pt.PivotFields("week_of_year")
pf.CurrentPage = Format(Date, "ww")
End Sub
If for some reason this field absolutely must stay in the PivotTable as a row field, you can still filter without looping by the following method if you have Excel 2010 or later
Make a copy of the PivotTable, and drag the 'week_of_year' field
in the copy to the Report Filter area
Set up a slicer on the week_of_year field on one PivotTable, and
connect it to the other PivotTable via the Report Connections
dialog. (Right click on the Slicer, select 'Report Connections')
Amend the above code so it runs on the 2nd PivotTable.
The Slicer will then sync the two PivotTables.
If you want to filter on more than one value, drag the field to the ROWS area, and use this:
Sub FilterOnWeek2()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim lStart As Long
Dim lEnd As Long
lEnd = Format(Date, "ww")
lStart = Val(Format(Date, "ww")) - 1
Set pt = Worksheets("LO").PivotTables("PivotTable3")
Set pf = pt.PivotFields("week_of_year")
With pf
.ClearAllFilters
.PivotFilters.Add Type:=xlCaptionIsBetween, Value1:=lStart, Value2:=lEnd
End With
End Sub
If for some reason you don't want this field in the PivotTable as a row field, follow the same general approach as above: make a copy of the PivotTable, put the field that you want to filter on in the copy as a ROWS field, connect the fields of interest together as a slicer, hide the slicer somewhere, and amend the code so it runs on the copy of the PivotTable with the rowfield in it.
I recommend you read my article at http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/ if you want to learn more about efficiently filtering PivotTables.

Related

Show spesific sections of pivot table using VBA

I'm trying to create a macro that will expand certain details in a pivot table. The pivot table is grouped, where Response is the parent of AnswerOrder. The condition I want to create is that Response should only expand if AnswerOrder is not blank.
The current macro will loop through, and expand all responses, because Im unsure how I can specify that it should only expand the parent of the pivotItem and not all.
Sub Macro8()
Dim pi As PivotItem
Dim ps As PivotTable
Dim res As PivotField
Dim ans As PivotField
Set ps = ActiveSheet.PivotTables("PivotSurvey")
Set res = ps.PivotFields("Response")
Set ans = ps.PivotFields("AnswerOrder")
For Each pi In ans.PivotItems
If pi = (blank) Then
res.ShowDetail = False
Else
res.ShowDetail = True
End If
Next pi
End Sub

Set Pivot Table Page filter with wildcard

I'm trying to set a Page filter in a Pivot Table, using string "Test" as base of search, so that it returns anything that contains that piece of String on it. I tried using * as wildcard for the string, but it returns an error.
I have been able to do this for Pivot Filters (columns/rows), but seems that Page filters (the ones on top/outside of the pivot table) use a different method or syntax.
I've tried searching in other threads and did not find an answer that fits my needs. Here is part of the code:
Dim pt As PivotTable
Dim pf As PivotField
Dim TextFilter As String
Set pt = ActiveSheet.PivotTables("PivotTable3")
Set pf = pt.PivotFields("Title")
TextFilter = "Test"
pt.PivotCache.Refresh
pf.ClearAllFilters
The below line works for exact string match:
ActiveSheet.PivotTables("PivotTable3").PivotFields("Title").CurrentPage = TextFilter
The below line doesn't work for partial string match (or contains):
ActiveSheet.PivotTables("PivotTable3").PivotFields("Title"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:="Test"
How can I set the Page filter for strings like Test ?
Additionally, what would be the best solution for looping the final (correct) code for other Pivot Tables within the same Worksheet and/or within the Workbook ?
It would be useful to see documentation to explain why PivotFilters.Add does not work for page filters e.g. see here and here.
However, a simple loop does work, as shown in this post that you may have seen already, but does not specify page filters.
So you can do something like this:
Option Explicit
Sub Test()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim strLike As String
Set pt = ThisWorkbook.Worksheets("Sheet1").PivotTables(1)
Set pf = pt.PivotFields("name")
strLike = "b*"
pt.PivotCache.Refresh
pf.EnableMultiplePageItems = True ' make sure the filter accepts multiple items
pf.ClearManualFilter ' make sure to reset to avoid an error for no active filter
For Each pi In pf.PivotItems
pi.Visible = (pi.Name Like strLike)
Next pi
End Sub
To use this in a loop of all worksheets in a workbook, you can extend like this:
Option Explicit
Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
For Each pt In ws.PivotTables
PivotPageByWildcard pt, "name", "b*"
Next pt
Next ws
End Sub
Sub PivotPageByWildcard(pt As PivotTable, strField As String, strLike As String)
Dim pf As PivotField
Dim pi As PivotItem
Set pf = pt.PivotFields(strField)
pt.PivotCache.Refresh
pf.EnableMultiplePageItems = True
pf.ClearManualFilter
For Each pi In pf.PivotItems
pi.Visible = (pi.Name Like strLike)
Next pi
End Sub
Simple test case:

Filtering a Pivot Table Based on Variable Range

My objective is to filter a pivot table using a range in another sheet. This range pulls data from a 3rd sheet, which is the data dump that kicks off a whole hosts of formulas and changes every time it is used.
I have the below code but what I can see it doing is running through each Pivot Table field, comparing it to the range, and then removing the filter. I have 32,000 fields that need to be checked so the current macro is too slow to use.
Could anyone help me fix the code so that it only filters based on values in the range that are Not Blank?
Sub PT()
Dim PT As PivotTable
Dim PI As PivotItem
Set PT = Sheets("Pivot_Sheet").PivotTables("PivotTable2")
With Sheets("Pivot_Sheet").PivotTables("PivotTable2").PivotFields("Product")
.ClearAllFilters
End With
For Each PI In PT.PivotFields("Product").PivotItems
PI.Visible = WorksheetFunction.CountIf(Sheets("Sheet1").Range("J2:J100"),
PI.Name) > 0
Next PI
Set PT = Nothing
End Sub
Your code is going to be slow on many, many counts. Have a read of my blogpost on this subject if you're interested in learning about the bottlenecks to avoid when filtering PivotTables.
The below code should get you started. If you have any questions, just holler.
Option Explicit
Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vList As Variant
Set pt = ActiveSheet.PivotTables("PivotTable2")
Set pf = pt.PivotFields("Product")
vList = Application.Transpose(ActiveWorkbook.Worksheets("Sheet1").Range("J2:J100"))
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
With pf
'At least one item must remain visible in the PivotTable at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.PivotItems(1).Visible = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vList
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the items of interest
On Error Resume Next
If InStr(UCase(Join(vList, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
End If
On Error GoTo 0
End With
pt.ManualUpdate = False
End Sub

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

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?
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
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.

Excel VB Code to Set Filter to a range of Options

I currently have a Pivot Table that pulls its data from a SharePoint site. With this Pivot table I want to use a Button to set the Filter to a certain date range. I used this site to get the filter to change the Filter value to a certain date, code below:
Sheets("Sheet2").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").CurrentPage = Date
This works well to reset the filter to the current days date, but I can't seem to find any way to make it set the filter to all the dates for the past 5, 10, or 15 days, or even to set the filter to all the dates for the current month.
Any assistance would be greatly appreciated.
Given that you are trying to apply a date range to your ReportFilter (as evidenced with .CurrentPage = Date, you will need to loop through all the PivotItems in the Date PivotFields and test against your date range.
Something like this below (untested):
Dim ws as Worksheet, pt as PivotTable, pf as PivotField, pi as PivotItem
Dim dStart as Date, dEnd as Date
dStart = #1/1/2015#
dEnd = #1/31/2015#
Set ws = Sheets("Sheet2")
Set pt = ws.PivotTables("PivotTable1")
Set pf = pt.PivotFields("Date")
With pf
.ClearAllFilters
For each pi in pf.PivotItems
If pi.Value > = dStart And pi.Value <= dEnd Then
pi.Visible = True 'or maybe pi.Selected = True
Else
pi.Visible = False 'or maybe pi.Selected = False
End If
Next
End With
Emmerson: You don't say what version of Excel you have. I'm using Excel 360, which gives me several ways to filter a PivotTable on a date range directly.
First, if your date field happens to be in the Rows or Columns area (but not the Filters/Page area as in your particular case) there's the Date Filters option available from the Filter dropdown:
And secondly, in Excel 2013 or later there are timelines:
As Scott rightly says in the comments above, the first option only works directly if the PivotField you want to filter is not a PageField i.e. it is not in the Filters pane of the PivotTable Fields list. Because if it is in the Filters pane, then you don't get any of the filter options shown above, as evidenced in the following screenshot:
But there's an easy workaround: simply drag it out of the PivotTable altogether, because you can actually still filter on a field that isn't in the PivotTable:
Firing up the macro recorder as I set that 'Between' filter resulted in the following code:
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").PivotFilters.Add2 _
Type:=xlDateBetween, Value1:="23/12/2015", Value2:="31/12/2015"
Here's a generalized version of that, that will filter any date pivotfield to whatever last X you want:
Sub LastXDays(lDays As Long, Optional pf As PivotField)
Dim StartDate As Date
Dim EndDate As Date
EndDate = Date
StartDate = EndDate - lDays + 1
If pf Is Nothing Then
On Error Resume Next
Set pf = ActiveCell.PivotField
If Err.Number <> 0 Then GoTo errhandler
On Error GoTo errhandler
End If
If Not IsDate(pf.PivotItems(1)) Then GoTo errhandler
pf.ClearAllFilters
pf.PivotFilters.Add2 _
Type:=xlDateBetween, _
Value1:=CStr(StartDate), _
Value2:=CStr(EndDate)
errhandler:
End Sub
You would call that routine using something like this:
Sub Last5Days()
LastXDays 5, ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")
End Sub
Post back if that's unclear of if you need more help implementing this.

Resources