Broken Arrow

Dick et al tell me that my over-use of the arrow anti-patten is broken…

Broken Arrow

…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:
Broken Arrow Broken Arrow Remake

Here’s the sample file: PivotChange_20140802

7 Comments

  1. I have to say I agree with Dick, here.

    When you duplicate the “If” on your “End If”s, that’s a form of duplication. What happens if the condition changes? Will you *always* remember to update the End If comment? Would you bet serious money on it?

    It’s a small instance of the DRY Principle – “Don’t Repeat Yourself”; we should in general be sensitive to, and where possible strive to remove duplication.

    Some of the code above still makes my fingers itch, especially “PivotChange_UndoCheck”. For a start, there are two big loops there: couldn’t they be separated? As a first cust, I’d have a routine that builds the field dictionary and one that processes it. I might consider pushing the whole thing into a Class: PivotChangeUndoChecker, anyone?

    Anyway, just my $0.02c (about 1.17 of our English pence, at today’s exchange rates, I’m informed)

  2. Jeff Weir says:

    Hi Mike. Yeah, I occasionally find End Ifs with outdated If comments. Not a major. Certainly not as major as the mental processing overhead caused by my tendency to extreme anti-arrowhead in the first place, me thinks.

    Good question re the PivotChange_UndoCheck routine. But how small should we slice and dice our vegetables, I wonder? Any smaller, and I’ll need to spoon them into the mouth of the calling routine multiple times rather than using a fork just the three times. Are we pureeing just for the sake of it, or does it actually add some value? What value do you think this would add? Comprehension only? Does cutting everything up into smaller and smaller chunks get in the way of comprehension? Love to hear further elaboration on this.

    Putting the whole thing into a class was something I was toying with for a future post. Being very new to classes, I was wondering if this would make a good example of one, for a book I’m writing. So I’ll give it a go. Plus there’s lots of great movies about classes…so gives me the chance to butcher another movie poster :-)

    In fact, that PivotChange_UndoCheck routine is probably perfect for its own class, because building and interrogating dictionaries of dictionaries is something that I do over and over, and I might as well have a vanilla class that I can use in any project to this end.

    But that will be next week as I’ve got another more urgent project ahead of me that I’m just about to embark on:
    Broken Arrow

  3. Alex Godofsky says:

    This stuff wouldn’t be nearly as much of a problem if Microsoft had actually updated their IDE in the past decade or so…

  4. Peter Albert says:

    I’m also on Dick’s side. In fact, I’d go a bit further and recommend to refactor any routine that is longer than a normal screen (I limit myself to max 40 lines per sub).

    Regarding the arrow head anti-pattern inside any loops: If you put the whole “arrow” into a sub/function, you can completely flatten it by using the Exit Function statement. E.g. in your example:

        Dim pf As PivotField
        Dim lngFields As Long
       
        lngFields = 0
        For Each pf In pt.PivotFields
            If fctBlnCheckSingleItemAsCause(pf) Then
                lngFields = lngFields + 1
                strPossibles = strPossibles & pf.Name & ";"
            End If
        Next
        On Error GoTo 0

        If lngFields = 1 Then PivotChange_EliminationCheck = Left(strPossibles, Len(strPossibles) - 1)

    End Function

    Private Function fctBlnCheckSingleItemAsCause(pf As PivotField)
        fctBlnCheckSingleItemAsCause = False
       
        On Error Resume Next ' Need this to handle DataFields and 'Values' field
       
        If pf.Orientation = 0 Then Exit Function 'It's not hidden or a DataField
        If Not pf.EnableMultiplePageItems Then Exit Function
        If pf.AllItemsVisible Then Exit Function
           
        'It *might* be this field
        fctBlnCheckSingleItemAsCause = (Err.Number = 0)
                   
        Err.Clear

    End Function
  5. Peter Albert says:

    Damm! Missed the top line when copying the code. Is there any way to edit a comment?

    Anyway, here’s the complete code:

    Function PivotChange_EliminationCheck(pt As PivotTable, ByRef strPossibles As String) As String
       
        Dim pf As PivotField
        Dim lngFields As Long
       
        lngFields = 0
        For Each pf In pt.PivotFields
            If fctBlnCheckSingleItemAsCause(pf) Then
                lngFields = lngFields + 1
                strPossibles = strPossibles & pf.Name & ";"
            End If
        Next
        On Error GoTo 0

        If lngFields = 1 Then PivotChange_EliminationCheck = Left(strPossibles, Len(strPossibles) - 1)

    End Function

    Private Function fctBlnCheckSingleItemAsCause(pf As PivotField)
        fctBlnCheckSingleItemAsCause = False
       
        On Error Resume Next ' Need this to handle DataFields and 'Values' field
       
        If pf.Orientation = 0 Then Exit Function 'It's not hidden or a DataField
        If Not pf.EnableMultiplePageItems Then Exit Function
        If pf.AllItemsVisible Then Exit Function
           
        'It *might* be this field
        fctBlnCheckSingleItemAsCause = (Err.Number = 0)
                   
        Err.Clear

    End Function
  6. Peter Albert says:

    Damn! Misspelled damn! I guess it’s too early for me! ;-)

  7. Jeff Weir says:

    Hi Peter. I like that approach…flat as a pancake! I quite fancy Rob Van Gelder’s approach in the comments at http://dailydoseofexcel.com/archives/2011/03/03/vba-confessions/ too:

       Dim bln As Boolean
        bln = Not condition1
        If bln Then bln = Not condition2
        If bln Then bln = Not condition3
        If bln Then
            DoRealWork
        Else
            OptionalErrorLogging
        End If

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: