So if you’ve been merrily following along, then you’ll know that we’ve got a function that picks up which PivotField just got filtered in a PivotTable, with a couple of exceptions:
- If users change the PivotFilter list, but leave the same count of things visible, or
- If any stinky PageField filters read ‘Multiple Items’ both before and after the change.
We’re about to add something more to our previous function to handle those cases.
With a few very minor exceptions, the majority of our previous function remains unchanged, and looks like so:
Function PivotChange_GetFilterName(pt As PivotTable) As String
Dim strLastUndoStackItem As String
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim lngVisibleItems As Long
Dim lngFields As Long
Dim strVisibleItems As String
Dim bIdentified As Boolean
Dim strElimination As String
Dim bElimination As Boolean
Dim dicFields As Object 'This holds a list of all visible pivotfields
Dim dicVisible As Object 'This contains a list of all visible PivotItems for a pf
Dim varKey As Variant
Application.EnableEvents = False
On Error Resume Next 'in case the undo stack has been wiped or doesn't exist
strLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID: = 128).Control.List(1)
On Error GoTo 0
If strLastUndoStackItem <> "" Then
For i = 1 To pt.VisibleFields.Count
Set pf = pt.VisibleFields(i)
With pf
If .Orientation <> xlDataField And .Name <> "Values" Then
If .Orientation <> xlPageField Then
strVisibleItems = strVisibleItems & .Name & "|" & .VisibleItems.Count & "||"
Else
'pf.VisibleItems.Count doesn't work on PageFields
'So for PageFields we’ll record what that PageField’s filter currently displays.
strVisibleItems = strVisibleItems & .Name & "|" & .LabelRange.Offset(, 1).Value & "|" & .EnableMultiplePageItems & "||"
End If
End If
End With
Next i
Select Case strLastUndoStackItem
Case "Filter", "Select Page Field Item", "Slicer Operation"
With pt
If InStr(.Summary, "|") > 0 Then 'the Summary field contains previously recorded info about pivot layout etc
If .Summary <> strVisibleItems Then
For i = 0 To UBound(Split(.Summary, "||"))
If Split(.Summary, "||")(i) <> Split(strVisibleItems, "||")(i) Then
PivotChange_GetFilterName = "PivotFilter changed: " & Split(Split(.Summary, "||")(i), "|")(0)
bIdentified = True
Exit For
End If
Next i
End If 'If .Summary <> strVisibleItems Then
If Not bIdentified Then
'Check all the visible fields to see if *just one of them alone* has
' neither .AllItemsVisible = True nor .EnableMultiplePageItems = false.
' If that's the case, then by process of elimination, this field
' must be the one that triggered the change, as changes to any of the
' others would have been identified in the code earlier.
lngFields = 0
For Each pf In pt.VisibleFields
With pf
If .Orientation <> xlDataField And .Name <> "Values" Then
If .AllItemsVisible = True Then
'it's not this field
bElimination = True
ElseIf .Orientation = xlPageField And .EnableMultiplePageItems = False Then
' it's not this field either
bElimination = True
Else
'It *might* be this field
lngFields = lngFields + 1
strElimination = strElimination & .Name & ";"
End If 'If .AllItemsVisible = True The
End If 'If .Orientation <> xlDataField And .Name <> "Values" Then
End With
Next pf
If lngFields = 1 Then
PivotChange_GetFilterName = "PivotFilter changed: " & Left(strElimination, Len(strElimination) - 1)
bIdentified = True
Else
But now, to track down those exceptions, we’re going to have to work some magic. Or as I put it in the code:
' =================================
' We will have to use *The Force*
' =================================
For each visible PivotField, we’re going to compare the list of what is visible now to what was visible before. Bear in mind that we don’t know in advance what PivotTable the user is going to tamper with. Given this, you may be asking yourself:
You’re dead right, Golden Rod. And that will require us to either keep a duplicate of every PivotTable in the workbook, or to extract every single pivotitem in the entire workbook to a Dictionary or Array that we would have to continually update.
Unless we use the Force. Yes, let’s use the Force. After all, it is all around us.
With the help of The Force:
- We’re only going to record the settings for the PivotTable that just changed
- Then we’re going to programatically hit the Undo button
- Then we’re going to play spot-the-difference between what things looked like after the user made that change:
…and what it looked like before they made that change:
- Then we’re going to restore things back to the way the user wanted them:
To do this, we’re going to employ a Dictionary.
Of Dictionaries.
Like so:
If Not bIdentified Then
' The If statement above is purely there to catch the possibility that
' we failed to find the filter in the above code because it's the first
' time we've run the code, meaning nothing was previously stored in pt.summary
'Create master dictionary
Set dicFields = CreateObject("Scripting.Dictionary")
'Cycle through all visible pivotfields, excluding totals
For i = 0 To lngFields - 1
'Create dicVisible: a dictionary for each PivotField that contain visible PivotItems
Set dicVisible = CreateObject("Scripting.Dictionary")
Set pf = pt.PivotFields(Split(strElimination, ";")(i))
With pf
If .Orientation <> xlPageField Then
For Each pi In .VisibleItems
With pi
dicVisible.Add .Name, .Name
End With
Next pi
Else:
'Unfortunately the .visibleitems collection isn't available for PageFields
' e.g. SomePageField.VisibleItems.Count always returns 1
' So we'll have to iterate through the pagefield and test the .visible status
' so we can then record just the visible items (which is quite slow)
For Each pi In .PivotItems
With pi
If .Visible Then
dicVisible.Add .Name, .Name
End If
End With
Next pi
End If 'If .Orientation = xlPageField Then
'Write dicVisible to the dicFields master dictionary
dicFields.Add .Name, dicVisible
End With
Next i
Great, so we know what’s visible now. But what about before?
Well, in keeping with the Star Wars theme, anyone fancy a prequel?
Application.Undo
And now we’ll check how the old compares to the new:
For Each varKey In dicFields.keys
Set pf = pt.PivotFields(varKey)
Set dicVisible = dicFields.Item(varKey)
'Test whether any of the items that were previously hidden are now visible
If pf.Orientation <> xlPageField Then
For Each pi In pf.VisibleItems
With pi
If Not dicVisible.exists(.Name) Then
bIdentified = True
PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name
Exit For
End If
End With
Next
Else 'pf.Orientation = xlPageField
lngVisibleItems = dicVisible.Count
i = 0
For Each pi In pf.PivotItems
With pi
If .Visible Then
If Not dicVisible.exists(.Name) Then
bIdentified = True
PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name
Exit For
Else: i = i + 1 'this is explained below.
End If 'If Not dicVisible.exists(.Name) Then
End If 'If .Visible Then
End With
Next
' For non-PageFields, we know that the number of .VisibleItems hasn't changed.
' But we *don't* know that about Pagefields, and an increase in the amount of
' .VisibleItems won't be picked up by our Dictionary approach.
' So we'll check if the overall number of visible items changed
If Not bIdentified And i > lngVisibleItems Then
bIdentified = True
PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name
Exit For
End If
End If 'If pf.Orientation <> xlPageField Then
If bIdentified = True Then Exit For
Next
Great, we’ve found it. Now it’s time for operation Application.Redo!
WAIT! There is no Application.Redo method!
Aw, screw it…let’s use that Force stuff again:
'Resore the original settings
Application.CommandBars("Standard").FindControl(ID:=129).Execute
…and then set the Hyperdrive for home:
End If 'If Not bIdentified Then
End If 'If lngFields = 1 Then
End If 'If Not bIdentified Then
End If 'If InStr(.Summary, "|") = 0 Then
End With
Case Else: PivotChange_GetFilterName = strLastUndoStackItem
End Select
End If 'If strLastUndoStackItem <> ""
pt.Summary = strVisibleItems
Application.EnableEvents = True
'Cleanup
Set dicFields = Nothing
Set dicVisible = Nothing
End Function
Stormtrooper: Let me see your sample file.
Obi-Wan: [with a small wave of his hand] You don’t need to see his sample file.
Stormtrooper: We don’t need to see his sample file.
Obi-Wan: These aren’t the sample files you’re looking for.
Stormtrooper: These aren’t the sample files we’re looking for.
Obi-Wan: He can go about his pivoting.
Stormtrooper: You can go about your pivoting.
Obi-Wan: Move along.
Stormtrooper: Move along… move along.
Okay, okay…here’s the sample file.
Can you stop remotely squeezing my throat now, Darth?
PivotChange_20140802
Update
I have re-factored the code in the sample file as per the post at Broken Arrow.
Great post. If you use Excel in a different language make sure to change the following code:
strLastUndoStackItem = Application.CommandBars(“Standard”).Controls(“&Undo”).Control.List(1)
in german:
strLastUndoStackItem = Application.CommandBars(“Standard”).Controls(“&Rückgängig”).Control.List(1)
Normally VBA codes are working with english names/variables but in this case you use the caption of the element. And that is written in the language you are using.
Thanks Geeko. Turns out we can use this to get the last item in the Undo stack:
strLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID:=128).List(1)…and this to exectute the Redo method:
Application.CommandBars("Standard").FindControl(ID:=129).ExecuteI’m not sure whether that string of “Standard” will pose any problems in international versions or not. I believe it works it German so perhaps it works in all.
I also note that while you can replace that “Standard” with 3 for the Redo line e.g.
…doing the same for the strLastUndoStackItem line generates a “Object variable or With block variable not set” error.
Ah. The index for the “Standard” commandbar in my version of Excel is 14, not 3. So if I replace “Standard” with 14 in the above snippets it works perfectly. Which begs a couple of questions:
1. Is there any need to? i.e. are there versions of Excel that use something different than “Standard” to reference this bar?
2. Is that index number of 14 ever likely to vary for any reason? Or will it always refer to the “Standard” commandbar?
Anyone know?
Edit: Walkenbach knows. Excel 2007 Power Programming with VBA:
If you are writing code that will be used by a different language version of Excel, avoid using the Caption property to access a particular shortcut menu. The Caption property is language-specific, so your code will fail if the user has a different language version of Excel.
The CommandBar names are not internationalized, so a reference to CommandBars(“Standard”) will always work.
In Dutch:
Application.CommandBars(“Standaard”)
Thanks for the heads-up, snb.
This whole article… just rept(“very “,100) clever
=REPT(“Thanks, Rich”,1)
Wow! Dare I suggest Jeff, purely for the benefit of the Excel community, that maybe your better half should trot off on hols more often! (By the way are you eating properly?)
Hi Tony. To be sure, I’ve got much more time than usual to write up posts. And my diet ain’t what it used to be…
@Jeff
You might consider simplifying your code:
E.g. instead of
lngVisibleItems = dicVisible.Counti = 0
For Each Pi In pf.PivotItems
With Pi
If .Visible Then
If Not dicVisible.exists(.Name) Then
i = i + 1 'this is explained below.
bIdentified = True
PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name
Exit For
End If 'If Not dicVisible.exists(.Name) Then
End If 'If .Visible Then
End With
Next
' For non-PageFields, we know that the number of .VisibleItems hasn't changed.
' But we *don't* know that about Pagefields, and an increase in the amount of
' .VisibleItems won't be picked up by our Dictionary approach.
' So we'll check if the overall number of visible items changed
If Not bIdentified And i <> lngVisibleItems Then
bIdentified = True
PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name
Exit For
End If 'If i > lngVisibleItems Then
End If 'If pf.Orientation <> xlPageField Then
If bIdentified = True Then Exit For
You might stick to:
For j = 1 To pf.PivotItems.CountIf Not dicVisible.exists(pf.PivotItems(j).Name) Then Exit For
Next
If j <= pf.PivotItems.count Then Exit For
@snb: I don’t believe your revision will work. You need to test the list of visible items now against the list of visible items from before. Whereas your code tests each item – whether visible or not – against the list of visible items from before. Meaning that unless all items are visible, your revision will always think that this field changed, even if it didn’t.
Unfortunately, for PageFields you can’t iterate through the .VisibleItems collection, as there isn’t one. If your field is not a pagefield, then yes you can take a simpler approach, as I have in the block immediately above the one you have posted above:
'Test whether any of the items that were previously hidden are now visible If pf.Orientation <> xlPageField Then For Each pi In pf.VisibleItems With pi If Not dicVisible.exists(.Name) Then bIdentified = True PivotChange_GetFilterName = "PivotFilter changed: " & pf.Name Exit For End If End With Next Else 'pf.Orientation = xlPageFieldSo you can see from the above that I only take the more complicated route that you commented on if the simpler route isn’t available.
Granted, I could do without that i = i + 1 stuff in the excerpt. Except that I think it will be faster to iterate through the PivotItems collection natively than to use the index number to iterate through it. Given PivotFields regularly have upwards of tens of thousands of items in them, I’m choosing execution speed over code simplicity.
Have refreshed the sample file in this post with re-factored code as per http://dailydoseofexcel.com/archives/2014/07/23/broken-arrow/
Hi,
… An easier method to sync dashboard graphs :
(it is simpler to hold the ‘old values’ in a ‘duplicate’ pivot table !)
Sheet 1 (Graphs)
a. 1 Pivot Table with required Page selectors (PivotFields) for all PivotGraphs (It has
no Row, Column or Value fields – Its purpose is to allow ‘User Selections’)
b. 20+ Graphs
Sheet2
a. 20+ pivot tables (linked to the graphs on sheet 1)
These pivots have identical selectors to the pivot on Sheet 1
Process
User selects Page Item (Pivotfield) and changes selection (multiple/single/who cares)
Compare ‘Sheet1 Pivotfield Values (for each Pivotfield)’ against the same PivotField & Value’ in any of the ‘Sheet2 Pivots’
1 Pivotfield will have different values (if the user has updated anything!)
Update the ‘identified Pivotfield’ on the ‘Sheet 2 Pivots’ to the new values.
Result 20+ graphs are synced with the user selection (7 parameters).
Multiple selections can be made & they apply to ‘all’ graphs
Sheet 1 Page PivotsFields (The graphs on sheet 2 ALL have these Page PivotFields)
@fYear (Multiple Items)
#Snapshot (Multiple Items)
#Source Current
Dashboard (All)
EIs (All)
Mat_New (All)
FeeType (All)
Not the neatest code
#Snapshot does not apply to some graphs
t, msg etc are defined @module level
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
‘
‘ Change the Graphs
‘ All Graphs Changed To Match ‘Selection Criteria’ (Snapshot does NOT apply to 1st Row Graphs ‘S_’)
‘
On Error GoTo er
Dim itm, pvtS, pvt, pvtf, bl
Application.ScreenUpdating = False
Application.Calculation = xlManual
Msg = “Update Graphs – ” & msgErr: Btns = msgErrBtns
bl = False
For Each pvt In ActiveSheet.ChartObjects
For Each itm In Target.PageRange.Columns(1).Cells
If Not ((Left(pvt.Name, Len(amGphPfx)) = amGphPfx) And (itm.Value = apSnapshot)) Then
With pvt.Chart.PivotLayout.PivotTable.PivotFields(itm.Value)
For Each pvtf In .PivotItems
On Error Resume Next
t = Target.PivotFields(itm.Value).PivotItems(pvtf.Name).Visible
If t pvtf.Visible Then bl = True: GoTo fnd
On Error GoTo er
Next pvtf
End With
End If
Next itm
Next pvt
fnd:
If bl Then
For Each pvt In ActiveSheet.ChartObjects
If Not ((Left(pvt.Name, Len(amGphPfx)) = amGphPfx) And (itm.Value = apSnapshot)) Then
With pvt.Chart.PivotLayout.PivotTable.PivotFields(itm.Value)
For Each pvtf In .PivotItems
On Error Resume Next
t = Target.PivotFields(itm.Value).PivotItems(pvtf.Name).Visible
If t pvtf.Visible Then pvtf.Visible = t
On Error GoTo er
Next pvtf
End With
End If
Next pvt
End If
Msg = “”
er:
Application.Calculate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
If Msg “” Then MsgBox Msg, Btns, “UPDATE GRAPHS”
End Sub