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 <> "" 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
       
End Sub

 
Yep, I think this remake is much, much better looking than the original:
Broken Arrow Broken Arrow Remake

Updating the For Next AutoHotkey in the VBE

Last month I posted about some AHK scripts I was starting to use to make the VBE a little less gross every day. There were some awesome comments. I took Hubisan’s comment and ran with it through a few iterations. First, let’s go to the video.

I use a program called CamStudio. For some reason it’s blurry for the first 30 seconds. I really need to get Techsmith’s Camtasia. But it gets the point across for now.

I’m seriously digging the AHK stuff. Here’s the script:

:*:for ::
;when you type for{space}, replace it with caps so you know you're in AHK mode
SendInput FOR{Space}
;wait for the next word and store it in counter
Input, counter,I V T10,{Space}{Escape}
;finish with ESC and you thwart AHK
;but finish with a space and more stuff happens
if (ErrorLevel = "EndKey:Space")
    {
    ;if the next word is each, it's a for each loop
    if (counter = "each")
        {
        ;wait for the next word and store it in eachctr
        Input, eachctr, I V T10,{Space}{Escape}
        if (ErrorLevel = "EndKey:Space")
            {
            ;Once you know eachctr, fill in the Next line and go back up to the For line
            SendInput +{HOME}{DELETE}{Enter}Next %eachctr%{Up}For Each %eachctr%{Space}
            }
        }
    ;if the next word is one of these, you're opening a text file
    else if (counter = "Append" or counter = "Binary" or counter = "Input" or counter = "Output" or counter = "Random")
        {
        ;get the next word - it really should only be 'As'
        Input, askeyword, I V T10,{Space}{Escape}
        if (ErrorLevel = "EndKey:Space")
            {
            if (askeyword = "As")
                {
                ;the word after 'As' is the file number
                Input, filenum, I V T10,{Enter}{Escape}
                if (ErrorLevel = "EndKey:Enter")
                    {
                    ;complete the close statement, because I always forget that.
                    SendInput {Enter}Close{Space}
                    ;you got to send this part raw because there may be a # in there and that's special
                    SendRaw %filenum%
                    SendInput {Up}
                    }
                }
            }
        }
    else
        {
        ;and finally if it's not all that special stuff, it's just a for next
        SendInput +{HOME}{DELETE}{Enter}Next %counter%{Up}For %counter%{Space}
        }
    }
Return

I put in comments so hopefully you can follow along. All I’ve done is copy Hubisan’s code, so if I took something nice and made it total crap it’s because I don’t know what I’m doing.

Bob Phillips made a good point in the last post about how he doesn’t prefer the automation. The automation gets in the way sometimes and typing the code slows things down so you can use your brain a little more. Good points, I thought, but I still like the automation. I can relate to the point that it gets in the way sometimes. In a previous iteration, I would type For i and it would put Next i, plus a blank line, plus a tab. That means when I’m done with the For statement, I have to arrow down. I don’t want to arrow down. I want to hit enter, then tab. So I made the automation fit the way I want to work and now I’m very happy with it.

What caused that PivotTableUpdate? Episode IV

Pivot Wars 3 Small

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:

C3PO 2

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:

  1. We’re only going to record the settings for the PivotTable that just changed
  2. Then we’re going to programatically hit the Undo button
  3. Then we’re going to play spot-the-difference between what things looked like after the user made that change:
    After2

    …and what it looked like before they made that change:
    Before2

  4. Then we’re going to restore things back to the way the user wanted them:
    After2

 
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!

junk

 
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_GetFilterName_20140712

 
Test Pattern

Pre-Order 101 Ready-To-Use Excel Formulas


The venerable Mike Alexander and I wrote a book last Spring and now you can pre-order it at Amazon (ships next month). 101 Ready-To-Use Excel Formulas

This book is not a list of worksheet functions and a description of their arguments. It contains fully formed formulas that solve real world problems. For example, there’s a whole chapter on financial formulas like creating an amortization schedule and calculating depreciation. I know financial stuff isn’t everyone’s cup of tea, that’s why we included 101 formulas. Mike wanted to write a book called One Ready-to-Use Excel Formula, but I said “Wait, what if we increased that number so there’s something for everyone?” I’m always looking out for you, dear reader.

You definitely want to buy one for yourself. But you should also buy one for that person in the office that needs it. You know that person who adds up the numbers in a spreadsheet on a calculator and then types the sum into Excel? Leave a copy of this book anonymously on his desk. Your boss might even reimburse you for it.

What caused that PivotTableUpdate? Part Tres.

Okay, so:

  • In Part One, we considered the problem of determining what actually triggered a PivotTableUpdate (or it’s equally gormless twin, the PivotTableChangeSync event)
  • In Part Two we worked out that we could tell via the contents of the Undo Stack whether the update was caused by filtering, a refresh, a structure change, or other less common tweaks – and we determined that we still couldn’t tell what particular PivotFilter a user might have changed.

But you already know that.

Today, we’ll wrap this knowledge in a function that will determine what triggered a PivotTableUpdate event by reading and returning the related Undo Stack entry. If the update event was triggered by some hoodlum filtering the pivot, the function will *try* to determine which PivotField it was so that it can additionally return the name of that PivotField. I say *try* because there are no guarantees in life apart from death, taxes, and the fact that when my wife goes to sunny Spain for 6 weeks I get to stay behind in the Southern Hemisphere winter and pay for it. (Ah well…she took the kids, so we *both* get a holiday of sorts.)

So how are we going to do this? First, we’ll use that underwhelming PivotTableUpdate event as a trigger for our PivotChange function. In this case we’ll feed that PivotChange result to a messagebox, for instant feedback.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim strWhatHappenned As String
    strWhatHappenned = PivotChange(Target)
    If strWhatHappenned <> "" Then MsgBox strWhatHappenned
End Sub

Then in our actual function PivotChange, we’ll start by retrieving the most recent item from that Undo Stack.

    Dim strLastUndoStackItem As String
    Dim pf As PivotField
    Dim i As Long
    Dim strVisibleItems As String
    Dim bIdentified As Boolean
    Dim strElimination As String
    Dim bElimination As Boolean
   
    Application.EnableEvents = False
   
    On Error Resume Next 'in case the undo stack has been wiped or doesn't exist
    strLastUndoStackItem = Application.CommandBars("Standard").Controls("&Undo").Control.List(1)
    On Error GoTo 0

The next thing we’re going to record how many visible items there are in each visible PivotField to a pipe-delimited string, using the pf.VisibleItems property:

    If strLastUndoStackItem <> "" Then
        For i = 1 To pt.VisibleFields.Count
            Set pf = pt.VisibleFields(i)
            With pf
                If .Orientation <> xlDataField Then
                    If .Name <> "Values" Then
                        If pf.Orientation <> xlPageField Then
                            strVisibleItems = strVisibleItems & .Name & "|" & pf.VisibleItems.Count & "||"

…unless it’s a PageField, because stinky PageFields don’t have said pf.VisibleItems property. You can pf.VisibleItems them all you want, and all you’ll ever get back is “1″. God, I hate PageFields. So for PageFields we’ll record what that PageField’s filter currently displays. This will either say “(All)” or “(Multiple Items)”, or will contain the name of just one PivotItem in the event that it’s filtered to show just one PivotItem. UPDATE: We’ll also record whether “Select Multiple Items is checked, in case a user changes that setting but changes nothing else.

                        Else
                            strVisibleItems = strVisibleItems & .Name & "|" & pf.LabelRange.Offset(, 1).Value & "|" & .EnableMultiplePageItems & "||"
                        End If
                    End If 'If .Name <> "Values" Then
                End If 'If .Orientation <> xlDataField Then
            End With
        Next i

Note that we didn’t use the pf.CurrentPage to retrieve the name of that stinky PageField, because if the PageField has been set so that the user can select multiple items (i.e. EnableMultiplePageItems = True) then surprise surprise pf.CurrentPage always returns “(All)” even if just one item is selected. So instead we’ll use pf.LabelRange.Offset(, 1).Value to get the filter’s title. God, I hate PageFields.

Now we’ll check if that PivotTableUpdate was caused by a user filtering a PivotField.

        Select Case strLastUndoStackItem
            Case  "Filter", "Select Page Field Item"

If it was, we’ll use that record of currently visible items we just put together. How? Well, we’re going to compare it against the number of items that were visible before the Pivot was refreshed. If there’s a difference for a particular field, then bing! we have our culprit. But where do we get those previous pf.VisibleItems stats from? Why, we stored them somewhere clever the last time this code ran…in the PivotTable itself!

PT Summary box 2

Ever wondered what pt.Summary did? Wonder no more…it allows you to read or write whatever you want to that “Description” box above. Here’s the code that does the reading and comparison:

                With pt
                    If InStr(.Summary, "|") = 0 Then 'the Summary field contains NO previous info about pivot layout etc
                        PivotChange = "PivotFilter changed: Unable to determine which one." 'Ahh, but we will, next time.
                    Else
                        If .Summary <> strVisibleItems Then
                            For i = 0 To UBound(Split(.Summary, "||"))
                                If Split(.Summary, "||")(i) <> Split(strVisibleItems, "||")(i) Then
                                    PivotChange = "PivotFilter changed: " & Split(Split(.Summary, "||")(i), "|")(0)
                                    bIdentified = True
                                    Exit For
                                End If
                            Next i
                        End If 'If .Summary <> strVisibleItems Then

So far, we’ve got code that will pick up most instances of a PivotField being filtered. But not all, because our method so far relies on there being a change in the number of visible items in a PivotField. Meaning if some malicious filterer (filteree?) changes the filter selection whilst leaving the same number of things visible, then we’ll miss it.

What’s more, if the PivotField is a PageField and the filter text reads ‘Multiple Items’ both before and after the change, then because we were forced to rely on picking up changes in the actual filter’s titleg rather than the unhelpful .visibleitems property, we wouldn’t have noticed any change even if the user did leave a different amount of items visible before and after. Stinky PageFields. Ought to be ashamed of yourselves.

But even in both of those cases, we’ve got one last-ditch effort to identify the culprit with the information that we already have to hand. Can you think of it? No? Come on now…how often have I said to you:

When you have eliminated the impossible, whatever remains, however improbable, must be the truth.

That’s right…once. So pay attention, Sherlock. If we check all the visible fields to see if *just one of them alone* has neither .AllItemsVisible = True nor .EnableMultiplePageItems = false, 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.

Here’s Watson store:

                        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 eliminaiton, 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.
                            i = 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
                                            i = i + 1
                                            strElimination = strElimination & .Name & ";"
                                        End If 'If .AllItemsVisible = True The
                                    End If 'If .Orientation <> xlDataField And .Name <> "Values" Then
                                End With
                            Next pf
                           
                            If i = 1 Then
                                PivotChange = "PivotFilter changed: " & Left(strElimination, Len(strElimination) - 1) & "."
                            ElseIf bElimination = True Then PivotChange = "PivotFilter changed: one of " & Left(strElimination, Len(strElimination) - 1) & "."
                            Else: PivotChange = "PivotFilter changed: Unable to determine which one."
                            End If 'If i = 1 Then
                        End If 'If Not bIdentified Then
                    End If 'If InStr(.Summary, "|") = 0 Then
                End With

And if the PivotTableUpdate wasn’t caused by filtering, then all we need do is tell the calling procedure what that action the user performed was:

            Case Else: PivotChange = strLastUndoStackItem
        End Select

All that’s left now is to overwrite the old record of visible fields in that PivotTable Alt Text box with the current record, so that next time the code runs we’ll have something to reminisce about:

        pt.Summary = strVisibleItems
        End If 'If strLastUndoStackItem <> ""
        Application.EnableEvents = True
End Function

So there we have it: a function that lets you know what triggered a PivotTableUpdate event and that does it’s *utmost* to let you know which PivotFilter was changed, if any.

Here’s a sample file with it all good to go:
PivotChange_20140710

Sure, it will still not capture cases where malicious filterers (filterees?) leave the same number of things visible, or where any stinky PageField filter read ‘Multiple Items’ both before and after the change. But it will warn you if that happens, and it’s not like that’s gonna happen every time.

And besides, in our upcoming season finale I’ll introduce an additional function that will do a far deeper, resource-intensive dive in that particular case.

Till then, Hasta Pronto.

Do you use LinkedIn?

Why not? You could be getting helpful notifications like this one:

Brazil

Now, what kind of skills can I endorse former Brazilian football manager Luiz for? Excel skills? Dunno. Ball skills? Maybe. Management skills? Pah!

What caused that PivotTableUpdate? Part Two.

In Part One, we considered the problem of determining what actually triggered a PivotTableUpdate (or it’s equally gormless twin, the PivotTableChangeSync event), with a view to identifying when a specific PivotField is filtered. Today we’re going to take a look at how we can find out more about what triggered those events. And what better place to glean information about the last action the user performed than here:

Undo

That’s right, the Undies stack. (That’s what we call it down-under). Or rather, the Undo stack to you uptight northerners. (Ok, enough of the innuendo and Double entendre.)

Go on, then…show us what’s in your undies…er…undo stack, Jeff:

Undo Pivot Actions 5

Wow: all of the above relate to some kind of action on a PivotTable. If only we could access that list, we’d have a pretty rich source from which to answer the title of this post. And we can indeed do just that.

If you want everything in that list, then you can use this code from MVP Siddharth Rout at msdn:

For i = 1 To xlApp.CommandBars("Standard").Controls("&Undo").Control.ListCount
UnDoList(i) = xlApp.CommandBars("Standard").Controls("&Undo").Control.List(i)
Next

…and if you just want the last undo item, you can use this:

Application.CommandBars("Standard").Controls("&Undo").List(1)

Let’s take a look at how all the different things that raise a PivotTableUpdate event get reflected in that Undo list. If an action isn’t listed in the below table, then as far as I know from my rather in-exhaustive testing, it doesn’t raise a PivotTableUpdate event.

Actions and associated undo stack text v2

There’s a few things worth noting about the above.

  • Firstly, we can now clearly determine whether the update was caused by filtering, a refresh, a structure change (in which case the Undo Stack just says ‘Pivot’, or other less common tweaks.
  • Secondly, while we can use this to confirm whether or not a PivotTableUpdate event was in fact caused by someone adjusting a PivotFilter, we still can’t tell which filter.
  • Thirdly, it’s surprising just how many things trigger an update – which is why it will be good to call out filter changes explicitly in the event that we want to sync lots of large pivots.
  • And finally, one of the actions – adding/amending/deleting a Calculated Field – actually clears the Undo Stack. How weird is that?

Okay, that’s enough for today…I’ve got to go cook my dinner. (My wife is in Spain with the kids, and so apparently it won’t cook itself). Tune in next time, when we’ll look at how we can write a routine that leverages off the undo stack, and that also helps us determine not only that a PivotField was filtered, but which PivotField it was.

What caused that PivotTableUpdate? Part One.

Over at MSDN, ToWIZ writes:

I’m looking for a detailed guide that would help users understand the details of PivotTable events and their functioning. The documentation has only one sentence for each event. Surely Microsoft doesn’t consider this to be a detailed guide?

Apparently so.

Microsoft:

  • The PivotTableUpdate event occurs after a PivotTable report is updated on a worksheet.
  • The PivotTableChangeSync occurs after changes to a PivotTable. This event can be used only in Excel 2010 projects.

And let me get this straight: reading between the lines on this extensive documentation, you’re telling me that the new event does the same thing as the old event, except for the fact that it only works in Excel 2010 or later? Wow. Quite some improvement.

I can’t find a single thing that differentiates these two events – either on the web or in practice. Here, you try. Put this in a Sheet Module where you’ve got some pivots, and play around with them:

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Debug.Print "PivotTableChangeSync: " &amp; now()
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Debug.Print “PivotTableUpdate: ” & now()
End Sub

Did you find a single case where one got triggered and the other didn’t? Me neither.

— UPDATE —

Eric van Rooijen did: Ticking the ‘Defer Layout Update’ option in the PivotFilter Pane means that only the Worksheet_PivotTableChangeSync gets triggered when changing PivotTable Fields.

You’ve almost got to wonder if someone on the team at Redmond misheard the brief for that 2010 addition. I’m sure they meant to introduce a new handler called PivotFieldChangeSync that would allow us to do something that we currently can’t – work out exactly what a user was doing to a PivotField (e.g. filtering a particular field). Instead we got this rehash with less scope than the old thing, as near as I can tell.

Which is a pity. Because PivotTables are the best thing about Excel, and PivotFilters (and now Slicers) are how users interact with that best thing. And here we are in Excel 2013 with still no good way to find out what PivotFilter a user just changed.

Why would you want to know that? Plenty of reasons…one of which is so that then you could efficiently sync a whole bunch of pivots in a dashboard in the case that slicers aren’t an option (e.g. the pivots are on different caches, or users have an earlier version of Excel that doesn’t support slicers). In that scenario, relying on just one of the above event handlers to run the code is damned inefficient, because:

  • It would get triggered by any old change that you make to a Pivot.
  • Even when it does get triggered by someone actually changing a PivotFilter, the question remains…which one did they change? Those events won’t tell you…

Don’t go thinking that a Worksheet_Selection change is going to help you work it out, because clicking on a PivotFilter or Slicer does not change your selection. And don’t go thinking you can use a Worksheet_Change event to capture the filter refreshing neither…when a PivotTable gets updated, the whole PivotTable gets updated, meaning that Worksheet_Change event returns the entire range that a PivotTable occupies – not just the cell behind the filter that a user just changed.

All this means that if you wanna say sync a whole bunch of pivots – and slicers aren’t an option – then relying solely on one of those insensitive Update events alone means you’ll have no choice but to sync pretty much every visible field that appears in the master pivot…something that may result in unacceptable delays to users if there are lots of pivots with lots of fields and with lots and lots of pivotitems in them. It could take many many minutes to iterate through all of them.

Sure, you can build some sort of userform control or array of shapes (one for each pivotfield) that the user clicks before they say filter a particular field. But that sounds complicated and quite likely bespoke to the dashboard concerned.

Or perhaps you could programatically put some invisible shapes in front of each PivotFilter, so that when when the user goes to click the PivotFilter they actually click those shapes instead, meaning you can then use application.caller to work out which shape – and therefore which PivotFilter – they clicked on. But you’d have to use SendKeys to open the filter that they just thought they clicked on, and you’d have to ensure those invisible boxes always moved with the PivotTable. Pretty invasive and unreliable stuff, really. And pretty complicated to set up.

Screw that…how ’bout a generalised solution that works right out of the box on any pivot, with no setup whatsoever?

How would you capture changes to specific PivotFields and the like?

Got a good method? Let us know in the comments. Got no idea? Tune in next time to see my approach.

Adding a New Worksheet to the End of the Workbook

I can think of five ways to add a new worksheet to a workbook. There may be more, but I can only think of five.

  1. Alt + i + w – this is the way I do it now. I’m trying to get away from the 2003 keyboard shortcuts, but this one remains.
  2. Alt + h + i + s – this is what I should be using because it’s on the Ribbon, but it’s also one extra key.
  3. Click the Insert Worksheet “tab” to the right of all the real sheets.
  4. Use the Shift + F11 keyboard shortcut for the Insert Worksheet “tab” that inexplicably behaves differently than clicking the tab.
  5. Right clicking on a sheet tab and choosing Insert… and going through the dialog box.

Only one of these five methods inserts the worksheet to the right of the active sheet, kind of. #3, the mouse only one, inserts a worksheet at the end of all sheets. All the other methods, including Shift + F11, insert a worksheet to the left of the active worksheet. I’m not much of a clicky guy as you know, preferring the keyboard. But sometimes I want the new worksheet to be at the end. So what’s a guy to do? Acquiesce and reach for the mouse? I don’t think so.

I have an add-in called UIHelpers.xlam. In that add-in is a CAppEvents class for controlling application level events. One event that I’m now using is the Application_WorkbookNewSheet event. It listens for when a new sheet is added to any workbook.

Private Sub mxlApp_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object)

    If Sh.Index = Wb.Sheets.Count - 1 Then
        Sh.Move , Wb.Sheets(Wb.Sheets.Count)
    End If

End Sub

If the new sheet is the penultimate sheet, move it to the end. When I’m on the last sheet and insert a new sheet, more often than not I want the new sheet to be to the right. There are a few times when that’s not true and I’ll have to move them. But this will cut down on manually moving worksheets significantly.

Converting Numbers to Words Part V

See Converting Numbers to Words Part IV

No need to bite this one off in small chunks. Just need to make sure the triplets processing works at the next level.

Sub TEST_Millions()
   
    Debug.Assert NumbersToWords(1000000) = "one million"
    Debug.Assert NumbersToWords(1000001) = "one million one"
    Debug.Assert NumbersToWords(20000000) = "twenty million"
    Debug.Assert NumbersToWords(55555000) = "fifty-five million five hundred fifty-five thousand"
    Debug.Assert NumbersToWords(999999999) = "nine hundred ninety-nine million nine hundred ninety-nine thousand nine hundred ninety-nine"
   
End Sub

I’m just going to add a new If block for millions that looks a lot like the thousands If block. Of course I’ll be using exponents so I don’t have to type all those zeros.

Function NumbersToWords(ByVal dNumbers As Double) As String
   
    Dim sReturn As String
    Dim dRemainder As Double
   
    If dNumbers = 0 Then
        sReturn = "zero"
    Else
       
        dRemainder = dNumbers
       
        If dRemainder >= 10 ^ 6 Then
            sReturn = ProcessTriplet(dRemainder \ 10 ^ 6, "million")
            dRemainder = dRemainder - ((dRemainder \ 10 ^ 6) * 10 ^ 6)
        End If
       
        If dRemainder >= 1000 Then
            sReturn = sReturn & Space(1) & ProcessTriplet(dRemainder \ 1000, "thousand")
            dRemainder = dRemainder - ((dRemainder \ 1000) * 1000)
        End If
       
        If dRemainder > 0 Then
            sReturn = sReturn & Space(1) & ProcessTriplet(dRemainder)
        End If
       
    End If
   
    NumbersToWords = Trim$(sReturn)
   
End Function

All tests passed. The rest should be easy. I’m going to go a little sparse on the next tests.

Sub TEST_More()
   
    Debug.Assert NumbersToWords(1 * 10 ^ 9) = "one billion"
    Debug.Assert NumbersToWords(1000000001) = "one billion one"
    Debug.Assert NumbersToWords(999999999999999#) = "nine hundred ninety-nine trillion nine hundred ninety-nine billion nine hundred ninety-nine million nine hundred ninety-nine thousand nine hundred ninety-nine"
   
End Sub

I could create a new If block for each triplet, but I already know I’ll be refactoring, so what’s the point. I need to loop through however many triplets are there and process them.

Function NumbersToWords(ByVal dNumbers As Double) As String
   
    Dim sReturn As String
    Dim dRemainder As Double
    Dim vaTriplets As Variant
    Dim i As Long
   
    vaTriplets = Split(",,,thousand,,,million,,,billion,,,trillion", ",")
   
    If dNumbers = 0 Then
        sReturn = "zero"
    Else
       
        dRemainder = dNumbers
       
        For i = 12 To 0 Step -3
            If dRemainder >= 10 ^ i Then
                sReturn = sReturn & Space(1) & ProcessTriplet(dRemainder \ 10 ^ i, vaTriplets(i))
                dRemainder = dRemainder - ((dRemainder \ 10 ^ i) * 10 ^ i)
            End If
        Next i
       
    End If
   
    NumbersToWords = Trim$(sReturn)
   
End Function

Error: Overflow. I originally passed in a Double so I could do decimals, but never did the decimals. Anyway, it’s the integer division operator (\) that’s causing the problem. When you use a floating point number, like a Double, in an integer division expression, VBA casts it as a Long first. So anything more than 2.4 billion won’t work. Fortunately, MS has a fix.

Function NumbersToWords(ByVal dNumbers As Double) As String
   
    Dim sReturn As String
    Dim dRemainder As Double
    Dim vaTriplets As Variant
    Dim i As Long
    Dim lFixed As Long
   
    vaTriplets = Split(",,,thousand,,,million,,,billion,,,trillion", ",")
   
    If dNumbers = 0 Then
        sReturn = "zero"
    Else
       
        dRemainder = dNumbers
       
        For i = 12 To 0 Step -3
            If dRemainder >= 10 ^ i Then
                lFixed = Fix(Int(dRemainder + 0.5) / 10 ^ i)
                sReturn = sReturn & Space(1) & ProcessTriplet(lFixed, vaTriplets(i))
                dRemainder = dRemainder - (lFixed * 10 ^ i)
            End If
        Next i
       
    End If
   
    NumbersToWords = Trim$(sReturn)
   
End Function

All tests passed. And that’s it. I could add decimals, I suppose. Or even larger numbers.

The test-first methodology was pretty enjoyable, I have to say. This isn’t especially complicated code, but biting it off in small chunks made things flow nicely.