Change all pivot table dates if one is changed - excel

The macro works if I select a single date.
If I select multiple items on one pivot table, it then updates the rest of the pivot tables by selecting every option in the filter dropdown.
Example of code:
Private Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each pfMain In ptMain.PageFields
bMI = pfMain.EnableMultiplePageItems
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> _
wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields(pfMain.Name)
bMI = pfMain.EnableMultiplePageItems
With pf
.ClearAllFilters
Select Case bMI
Case False
.CurrentPage _
= pfMain.CurrentPage.Value
Case True
.CurrentPage = "(All)"
For Each pi In pfMain.PivotItems
.PivotItems(pi.Name).Visible _
= pi.Visible
Next pi
.EnableMultiplePageItems = bMI
End Select
End With
bMI = False
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I want this code to run automatically when a date is changed in a pivot table on a particular sheet, either by selecting a single date or multiple. I have about 10 pivot tables on this sheet (they all have their own data source).
When I select one date, say the 01/01/2022 (with select multiple items unchecked) it will update all the other pivot tables accordingly.
When I select one date with "select multiple items" checked, it will select every date/option from the dropdown filter.
What can be done to have the macro run and select multiple dates on all the other pivot tables?
I need to be able to select either a single date or a date range such as a whole month.

I'm not sure what all of your code is doing with the filters and what not, but here's a basic macro that refreshes all pivotables in the workbook (thisWorkBook). Make sure this is placed in a Module, not the worksheet tab.
Sub refreshAllPV()
Dim p As PivotTable, ws As Worksheet, wkbk As Workbook
Set wkbk = ThisWorkbook 'better to set this a parameter when calling
For Each ws In wkbk.Worksheets
For Each p In ws.PivotTables
p.PivotCache.Refresh
Next p
Next ws
End Sub
From here, you just need to capture the proper event. When I run this test code, it fires on both multiple and single filter changes. You might want to condition the action to only launch the macro if a particular pivot table is modified.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Const nNameOfDisiredPivot = "PivotTable1" 'or whatever it is. Make sure case is accurate
If Target.Name = nNameOfDisiredPivot Then
MsgBox "Macro called for change to: " & Target.Name 'included just for testing to see when event is called.
Call refreshAllPV
End If
End Sub

Related

VBA Excluding items from filter when they're not always there

Im trying to automatically exclude certain items from a Pivot table, there are some customers that i dont want to ever include, ive got the following VBA which seems to exclude them, but if they are not on the data the next time i run it, it cant find them to exclude and then stops working.
is there a way to get it to ignore the customer if it cant find them and move on to the next one?
Sub Filtering()
ActiveSheet.PivotTables("PivotTable2").PivotFields("CUSTOMER NAME"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable2").PivotFields("CUSTOMER NAME")
.PivotItems("Customer1").Visible = False
.PivotItems("Customer2").Visible = False
.PivotItems("Customer3").Visible = False
End With
End Sub
is there a way to get it to ignore the customer if it cant find them and move on to the next one?
Two ways I can quickly think of. Take your pick :)
WAY 1
Check if the pivot item exists and then try to work with it. Also it is best if you use Objects. Easy to manage your code.
Is this what you are trying?
Option Explicit
Dim pField As PivotField
Sub Filtering()
Dim ws As Worksheet
'~~> Change this to relevant sheet
Set ws = Sheet1
Dim pTbl As PivotTable
Set pTbl = ws.PivotTables("PivotTable2")
Set pField = pTbl.PivotFields("CUSTOMER NAME")
pField.CurrentPage = "(All)"
With pField
If DoesPivotItemExist("Customer1") Then .PivotItems("Customer1").Visible = False
If DoesPivotItemExist("Customer4") Then .PivotItems("Customer4").Visible = False
If DoesPivotItemExist("Customer3") Then .PivotItems("Customer3").Visible = False
End With
End Sub
'~~> Function to check if the pivot item exists
Private Function DoesPivotItemExist(pvtItem As String) As Boolean
Dim pitm As PivotItem
For Each pitm In pField.PivotItems
If pitm.Name = pvtItem Then
DoesPivotItemExist = True
Exit For
End If
Next pitm
End Function
WAY 2
Use On Error Resume Next and On Error GoTo 0 to hide the item without checking if they exist or not
For example
Option Explicit
Dim pField As PivotField
Sub Filtering()
Dim ws As Worksheet
'~~> Change this to relevant sheet
Set ws = Sheet1
Dim pTbl As PivotTable
Set pTbl = ws.PivotTables("PivotTable2")
Set pField = pTbl.PivotFields("CUSTOMER NAME")
pField.CurrentPage = "(All)"
With pField
HidePivotItem "Customer1"
HidePivotItem "Customer2"
HidePivotItem "Customer4"
End With
End Sub
Private Sub HidePivotItem(pvtItem As String)
On Error Resume Next
pField.PivotItems(pvtItem).Visible = False
On Error GoTo 0
End Sub

Update pivot table filters using date range from 2 cells and name from another cell

I have an Excel dashboard that updates tables and charts when the name and dates are changed in specific cells, but I also need 2 pivot tables to update using these cells too.
My name cell is D2:G2 and my date range cells are From: P2 To: R2
I've tried various solutions found on the net for updating pivot date ranges but none of them work when trying to link them with the name update code.
So far I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PTable As PivotTable
Dim PField As PivotField
Dim Str As String
On Error Resume Next
If Intersect(Target, Range("D2:G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set PTable = Worksheets("Stats").PivotTables("PivotTable1")
Set PField = PTable.PivotFields("BM attendees")
Str = Target.Text
PField.ClearAllFilters
PField.CurrentPage = Str
Application.ScreenUpdating = True
End Sub
I have some working VBA to update one of the pivots when the name is changed, but I need both pivots to update, and also need the dates on both pivots to update based on the date range.
If anyone can help with the VBA to get this working it would be greatly appreciated.
Here is an example for 1 pivottable to demonstrate how to select pivotitems within filters (= PageFields) of a pivot table. As you can not set a date range on a pagefield, you need to switch each corresponding pivot item visible or not.
You always have to ensure, that at least 1 pivotitem remains visible.
You also have to ensure, that the given attendee name (in Target.Text) corresponds to any pivot item, before you try to switch the currentpage to that attendee.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PTable As PivotTable
Dim PField As PivotField
Dim PItem As PivotItem
Dim AttendeeName As Range
Dim DateFrom As Range, DateTo As Range
Dim AtLeastItemRemainsVisible As Boolean
Set AttendeeName = ActiveSheet.Range("D2")
Set DateFrom = ActiveSheet.Range("D2")
Set DateTo = ActiveSheet.Range("R2")
Set PTable = Worksheets("Stats").PivotTables(1) ' or ("PivotTable1")
Application.ScreenUpdating = False
'Application.EnableEvents = False
' Select 1 attendee name as single filter page:
If Not Intersect(Target, AttendeeName) Is Nothing Then
Set PField = PTable.PageFields(1) ' or ("BM attendees")
PField.ClearAllFilters
PField.EnableMultiplePageItems = False
For Each PItem In PField.PivotItems
If PItem.Name = Target.Text Then
PField.CurrentPage = Target.Text
End If
Next PItem
' select all valid dates between two given dates:
ElseIf Not Intersect(Target, Union(DateFrom, DateTo)) Is Nothing Then
Set PField = PTable.PageFields(2)
PField.ClearAllFilters
PField.EnableMultiplePageItems = True
' at least 1 PivotItem must remain visible:
AtLeastItemRemainsVisible = False
For Each PItem In PField.PivotItems
If CDate(PItem.Name) >= CDate(DateFrom) _
And CDate(PItem.Name) <= CDate(DateTo) Then
AtLeastItemRemainsVisible = True
Exit For
End If
Next PItem
If AtLeastItemRemainsVisible Then
For Each PItem In PField.PivotItems
PItem.Visible = _
CDate(PItem.Name) >= CDate(DateFrom) _
And CDate(PItem.Name) <= CDate(DateTo)
Next PItem
End If
End If
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Separate story: I suggest to use a date filter on a corresponding rowfield or columnfield instead of using dates as PageField. Be aware that you have to convert date values into strings to use it with such a PivotFilter. Here's a general example:
Private Sub DateFilter()
With ActiveSheet.PivotTables(1).RowFields(1)
.ClearAllFilters
' between two dates:
.PivotFilters.Add2 _
Type:=xlDateBetween, _
Value1:=CStr(DateSerial(Year(Date) - 1, Month(Date), Day(Date))), _
Value2:=CStr(Date), _
WholeDayFilter:=True
' another example, please refer to macro recorder for special date ranges:
.PivotFilters.Add2 _
Type:=xlDateThisYear
End With
End Sub

show details for each pivot item in new sheet and change its name

I am trying to:
Create a drill down table for each visible company in the pivot table on a new sheet.
Rename the sheet with the company name.
The code I have seems to work until I apply a filter to the pivot table.
Sub Test1()
Dim pField As PivotField
Dim pItem As PivotItem
Set pField = Sheets("PivotTable").PivotTables(1).PivotFields("Company")
Application.ScreenUpdating = False
For Each pItem In pField.PivotItems
If pItem.Visible Then
pItem.DataRange.ShowDetail = True
ActiveSheet.Name = pItem.Name
End If
Next pItem
Application.ScreenUpdating = True
End Sub
Background on PivotItem.Visible
If you filter a PivotTable then some of your Rowfields or ColumnFields show less PivotItems.
Unfortunately each corresponding PivotField.PivotItem is still returned as Visible, even if you don't see it.
Also PivotField.VisibleItems.Count is not reduced.
Addressing "really" visible PivotItems
Filtering a PivotTable changes the visible DataRange of a PivotField, so you can loop over its cells and use the cell's value to identify each visible PivotItem:
Dim pItemCell As Range
For Each pItemCell In pField.DataRange
If pItemCell.Value <> "(blank)" Then
Set pItem = pField.PivotItems(pItemCell.Value)
pItem.DataRange.ShowDetail = True
ActiveSheet.Name = pItem.Name
End If
Next pItemCell
You may also loop over each PivotRowAxis.PivotLines().PivotLineCells().PivotItem.
Please see my answer here: https://stackoverflow.com/a/55444457/10908769
Getting Details for the GrandTotals Column
Dim pTable As PivotTable
Dim pField As PivotField
Dim i As Long
Set pField = Sheets("PivotTable").PivotTables(1).PivotFields("Company")
Set pTable = pField.Parent
If pTable.RowGrand = True Then
For i = 1 To pField.DataRange.Cells.Count
pTable.DataBodyRange.Cells(i, pTable.DataBodyRange.Columns.Count).ShowDetail = True
ActiveSheet.Name = pField.DataRange.Cells(i).Value
Next i
End If
Hint for ActiveSheet.Name
Please be aware, that there are restrictions for renaming a worksheet: https://stackoverflow.com/a/54620175/10908769

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

VBA Filter error

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.

Resources