Dick et al tell me that my over-use of the arrow anti-patten is broken…
…to the point that my Ifs are well out of sight of my EndIfs. So much so, that I’ve got into the habit of appending my closing IF statements with an apostrophe and then adding the text of the matching opening IF statement, so I can keep track of exactly where each block ends, like so:
End If 'If Not bIdentified Then
End If 'If lngFields = 1 Then
End If 'If Not bIdentified Then
End If 'If InStr(.Summary, "|") = 0
Dick tells me that if things have got that bad, the code should be refactored. After making some lame excuses, I thought I’d take these comments on board, and see whether a remake made for ultimately more satisfying viewing.
With this particular code, I’m trying to find out what PivotField (if any) got filtered. I have three separate tests – each of slightly increasing complexity. The first test doesn’t require much, and picks up what PivotField got filtered in probably 80% of cases. The 2nd test requires a little bit more processing, and probably picks up what PivotField got filtered in half the remaining cases. The last test requires something quite invasive, but will correctly identify those last remaining cases that the other tests missed.
Those three tests can easily be split into three separate functions, so that someone following along finds the whole code easier to conceptualize.
So here’s the first function, which checks the structure of the PivotTable after a change against a record of the structure that we previously saved to the PivotTable.Summary field:
Function PivotChange_LayoutComparison(pt As PivotTable, ByRef strVisibleItems As String) As String
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
For Each pf In pt.PivotFields
With pf
Select Case .Orientation
Case xlRowField, xlColumnField
strVisibleItems = strVisibleItems & .Name & “|” & .VisibleItems.Count & “||”
Case xlPageField
‘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 Select
End With
Next pf
With pt
If .Summary <> strVisibleItems Then
For i = 0 To UBound(Split(.Summary, “||”))
If Split(.Summary, “||”)(i) <> Split(strVisibleItems, “||”)(i) Then
PivotChange_LayoutComparison = Split(Split(.Summary, “||”)(i), “|”)(0)
Exit For
End If
Next i
End If
End With
End Function
And here’s the second function, that checks all the visible fields to see if *just one of them alone* has neither .AllItemsVisible = True nor .EnableMultiplePageItems = false. If so, 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 previous function.
Function PivotChange_EliminationCheck(pt As PivotTable, ByRef strPossibles As String) As String
'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.
Dim pf As PivotField
Dim pi As PivotItem
Dim lngFields As Long
lngFields = 0
On Error Resume Next ' Need this to handle DataFields and 'Values' field
For Each pf In pt.PivotFields
With pf
If .Orientation > 0 Then 'It's not hidden or a DataField
If .EnableMultiplePageItems And Not .AllItemsVisible Then
If Err.Number = 0 Then
'It *might* be this field
lngFields = lngFields + 1
strPossibles = strPossibles & .Name & ";"
Else: Err.Clear
End If
End If
End If
End With
Next
On Error GoTo 0
If lngFields = 1 Then PivotChange_EliminationCheck = Left(strPossibles, Len(strPossibles) - 1)
End Function
And lastly, here’s the function that records the .VisibleItems for the PivotTable that just changed, then programatically hits the Undo button so it can play spot-the-difference between what things looked like after the user made that change:
Function PivotChange_UndoCheck(pt As PivotTable, strPossibles) As String
Dim lngFields As Long
Dim i As Long
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
Dim ctr As CommandBarControl
Dim pf As PivotField
Dim pi As PivotItem
Dim bidentified As Boolean
Dim lngVisibleItems As Long
Application.EnableEvents = False
'Create master dictionary
Set dicFields = CreateObject("Scripting.Dictionary")
'Cycle through all pivotfields, excluding totals
For i = 0 To UBound(Split(strPossibles, ";")) - 1
'Create dicVisible: a dictionary for each visible PivotField that contain visible PivotItems
Set dicVisible = CreateObject("Scripting.Dictionary")
Set pf = pt.PivotFields(Split(strPossibles, ";")(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
Application.Undo
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
PivotChange_UndoCheck = pf.Name
bidentified = True
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
PivotChange_UndoCheck = pf.Name
bidentified = True
Exit For
Else: i = i + 1 'this is explained below.
End If
End If
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
PivotChange_UndoCheck = pf.Name
Exit For
End If
End If
If bidentified Then Exit For
Next
'Resore the original settings
With Application
.CommandBars(14).FindControl(ID:=129).Execute 'Standard Commandbar, Redo command
.EnableEvents = True
End With
End Function
Lastly, here’s how I call them all:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim strLastUndoStackItem As String
Dim strPossibles As String
Dim strVisibleItems As String
Dim strPivotChange As String
On Error Resume Next 'in case the undo stack has been wiped or doesn't exist
strLastUndoStackItem = Application.CommandBars(14).FindControl(ID:=128).List(1) 'Standard Commandbar, undo stack
On Error GoTo 0
If strLastUndoStackItem = "Filter" Or strLastUndoStackItem = "Slicer Operation" Then
strPivotChange = PivotChange_LayoutComparison(Target, strVisibleItems)
If strPivotChange = "" Then strPivotChange = PivotChange_EliminationCheck(Target, strPossibles)
If strPivotChange = "" Then strPivotChange = PivotChange_UndoCheck(Target, strPossibles)
Target.Summary = strVisibleItems
If strPivotChange <> "" Then MsgBox strPivotChange
Else:
MsgBox strLastUndoStackItem
End If
End Sub
Yep, I think this remake is much, much better looking than the original:
Here’s the sample file: PivotChange_20140802
