Quickly changing or deleting Named Ranges Redux

I know a good thing when I see it. Dick’s use of the word Redux in yesterday’s post for one. Dick’s nifty CreateDynamicNames() sub for another. Put them together, and you’ve got a winning combination. Or at least, 5 minutes of distraction between whatever the heck it is you’re supposed to be doing instead of reading this post. Work, most likely.

Yesterday I posted a barely fleshed out bit of code that took some of the tedium out of maintaining Named Ranges. Mostly it saved you scrolling through a potentially overwhelming list of Names in order to find the one you want to maintain or zap:

NameManager1

 
Today, we’re going to turn yesterday’s rather underwhelming interface:

Please select new range

 
…into this slightly less underwhelming interface:
Right Click

Our first step is to put some code in the Personal Macro Workbook to add those additional right-click items to the right-click menus – aka context menus – that we’re likely to use in relation to the grid. Three of these menus spring to mind:

  1. The “List Range PopUp” CommandBar that you see if you right click over a Table.
  2. The “PivotTable Context Menu” CommandBar that you see if you right click over a PivotTable.
  3. The “Cell” CommandBar that you’re likely to see if you right click over a range that’s not a Table or a PivotTable.

There’s probably more. Let me know in the comments if you can think of others relevant to this post.

Name your poison

Here’s the code I use to add the shortcuts:

Sub AddShortcuts()
    Dim cbr As CommandBar
    Dim i As Long
 
    DeleteShortcuts
 
    For i = 1 To 3
        Select Case i
        Case 1: Set cbr = Application.CommandBars("Cell")
        Case 2: Set cbr = Application.CommandBars("List Range PopUp")
        Case 3: Set cbr = Application.CommandBars("PivotTable Context Menu")
        End Select
       
 
       'Add Stand-alone buttons for Duplicate/Delete resource subs
       With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True)
           .Caption = Chr(Asc("&")) + "Rename Selected Named Range"
           .Tag = "RenameName"
           .OnAction = "RenameName"
           .Style = msoButtonIconAndCaption
           .Picture = Application.CommandBars.GetImageMso("NameDefine", 16, 16)
           .BeginGroup = True
       End With
   
       With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True)
           .Caption = Chr(Asc("&")) + "Point Selected Named Range Elsewhere"
           .Tag = "RepointName"
           .OnAction = "RepointName"
           .Style = msoButtonIconAndCaption
           .Picture = Application.CommandBars.GetImageMso("ArrangeByAppointmentStart", 16, 16)
       End With
     
       With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True)
           .Caption = Chr(Asc("&")) + "Zap the Selected Named Range"
           .Tag = "DeleteName"
           .OnAction = "DeleteName"
           .Style = msoButtonIconAndCaption
           .Picture = Application.CommandBars.GetImageMso("DeleteTable", 16, 16)
       End With
     
        With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True)
           .Caption = Chr(Asc("&")) + "Lightning fast Dynamic Ranges!"
           .Tag = "DynamicRanges"
           .OnAction = "CreateDynamicNames"
           .Style = msoButtonIconAndCaption
           .Picture = Application.CommandBars.GetImageMso("UMLEvents", 16, 16)
       End With
       
    Next
 
End Sub

Here’s the code I use to delete ‘em:

Sub DeleteShortcuts()
 
    Dim cbr As CommandBar
    Dim ctrl As CommandBarControl
    Dim i As Long
 
    For i = 1 To 3
        Select Case i
        Case 1: Set cbr = Application.CommandBars("Cell")
        Case 2: Set cbr = Application.CommandBars("List Range PopUp")
        Case 3: Set cbr = Application.CommandBars("PivotTable Context Menu")
        End Select
 
        ' Delete the custom controls with the Tag : My_Cell_Control_Tag.
        For Each ctrl In cbr.Controls
            Select Case ctrl.Tag
            Case "RenameName", "RepointName", "DeleteName", "DynamicRanges"
                ctrl.Delete
            End Select
        Next ctrl

    Next i
 
 
End Sub

That Chr(Asc(“&”)) + stuff in that first routine sets the accelerator keys, so that all you musophobes don’t have to obsessively wash your hands each time you use these. Instead, you can use the menu key:
Menu-Key

…and then hit the R, P, Z, or L keys accordingly.
CloseUp

I was going to try to spell something rude with these, but it was like playing Scrabble against Microsoft, who already took all the best letters. Cheats!

(Aside: There’s a good discussion over at Chandoo’s blog about the menu key, and what to do if some tight-wad manufacturer hasn’t put it on their machines.)

These shortcuts get added when Excel starts/closes courtesy of the Workbook_Open/Workbook_Close events in the ThisWorkbook module in my Personal Macro Workbook:

Private Sub Workbook_Open()
AddShortcuts
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteShortcuts
End Sub

So that sets the stage. Next, we need some actual routines to do something when we select from those right-click menus.

Hi. My name is…

(what?) My name is… (who?)
My name is… [scratches] Slim Shady

Here’s the main function: a routine that returns a delimited string containing the names of any names that reference your reference:

Function IdentifyNames(rng As Range) As String
 
'Identifies any Named Ranges that map directly to rng
Dim nm As Name
Dim strNames As String
 
For Each nm In ActiveWorkbook.Names
    If Replace(Replace(nm.RefersTo, "=", ""), "'", "") = ActiveSheet.Name & "!" & rng.Address Then
        strNames = strNames & nm.Name & "|"
    End If
Next
 
IdentifyNames = strNames
 
End Function

And here’s my three functions to Repoint, Rename, or completely ‘Reck those names:

Sub RepointName()
 
    Dim nm As Name
    Dim strNames As String
    Dim rngNew As Range
    Dim rngExisting As Range
    Dim lngNames As Long
    Dim strMessage As String
    Dim strMultipleNames As String
    Dim i As Long
   
    Set rngExisting = Selection
    strNames = IdentifyNames(rngExisting)
    lngNames = UBound(Split(strNames, "|"))
    If lngNames = -1 Then
        'There is no named range that matches. So let the user choose one.
        Application.Dialogs(xlDialogNameManager).Show
    Else:
        For i = 0 To lngNames - 1
            Set nm = ActiveWorkbook.Names(Split(strNames, "|")(i))
            If lngNames > 1 Then
                strMultipleNames = "I found " & lngNames & " Named Ranges that reference your selection, "
                strMultipleNames = strMultipleNames & "so we 'll go through them one by one."
                strMultipleNames = strMultipleNames & vbNewLine & vbNewLine
                strMultipleNames = strMultipleNames & "Name " & i + 1 & " of " & lngNames & ":"
                strMultipleNames = strMultipleNames & vbNewLine & vbNewLine
            End If
            On Error Resume Next
            Set rngNew = Application.InputBox( _
                Title:="Please select new range", _
                Prompt:=strMultipleNames & "Select the range where you want """ & nm.Name & """ to point at.", _
                Default:=Selection.Address, _
                Type:=8)
            On Error GoTo 0
            If Not rngNew Is Nothing Then
                nm.RefersTo = "='" & ActiveSheet.Name & "'!" & rngNew.Address
                rngNew.Select
            End If
        Next i
    End If
       
End Sub
Sub RenameName()
 
Dim nm As Name
Dim strNames As String
Dim nmExists As Name
Dim strRefersTo As String
Dim strMultipleNames As String
Dim strNew As String
Dim rng As Range
Dim lngNames As Long
Dim i As Long
 
    Set rng = Selection
    strNames = IdentifyNames(rng)
    lngNames = UBound(Split(strNames, "|"))
    If lngNames = -1 Then
        'There is no named range that matches. So let the user choose one.
        Application.Dialogs(xlDialogNameManager).Show
    Else:
        For i = 0 To lngNames - 1
            Set nm = ActiveWorkbook.Names(Split(strNames, "|")(i))
            If lngNames > 1 Then
                strMultipleNames = "I found " & lngNames & " Named Ranges that reference your selection, "
                strMultipleNames = strMultipleNames & "so we 'll go through them one by one."
                strMultipleNames = strMultipleNames & vbNewLine & vbNewLine
                strMultipleNames = strMultipleNames & "Name " & i + 1 & " of " & lngNames & ":"
                strMultipleNames = strMultipleNames & vbNewLine
            End If
            On Error Resume Next
            strNew = Application.InputBox( _
                Title:="Please input the new name...", _
                Prompt:=strMultipleNames & "Please type the new name for """ & nm.Name & """.", _
                Default:=nm.Name, _
                Type:=2)
            If strNew = "False" Then Exit Sub
            If Not strNew = nm.Name Then
                strNew = Fix_Name(strNew)
                On Error Resume Next
                Set nmExists = ActiveWorkbook.Names(strNew)
                On Error GoTo 0
                If nmExists Is Nothing Then
                    nm.Delete
                    ActiveWorkbook.Names.Add Name:=strNew, RefersTo:="='" & ActiveSheet.Name & "'!" & rng.Address
                Else:
                    MsgBox "That name already exists. Please choose another."
                    Set nmExists = Nothing
                End If
            End If
        Next
    End If
   
End Sub
Sub DeleteName()
 
Dim nm As Name
Dim strNames As String
Dim strMessage As String
Dim iResponse As Integer
Dim rngExisting As Range
Dim lngNames As Long
Dim i As Long
 
strNames = IdentifyNames(Selection)
lngNames = UBound(Split(strNames, "|"))
Select Case lngNames
    Case -1:
        'There is no named range that matches. So let the user choose one.
        Application.Dialogs(xlDialogNameManager).Show
    Case 1: ActiveWorkbook.Names(Split(strNames, "|")(0)).Delete
    Case Else:
        For i = 0 To lngNames - 1
            Set nm = ActiveWorkbook.Names(Split(strNames, "|")(i))
                strMessage = "I found " & lngNames & " Named Ranges that reference your selection, "
                strMessage = strMessage & "so we 'll go through them one by one."
                strMessage = strMessage & vbNewLine & vbNewLine
                strMessage = strMessage & "Name " & i + 1 & " of " & lngNames & ":"
                strMessage = strMessage & vbNewLine
                strMessage = strMessage & "Do you want to delete the Named Range """ & Split(strNames, "|")(i) & """?"
                iResponse = MsgBox( _
                            Title:="Multiple Names Found", _
                            Prompt:=strMessage, _
                            Buttons:=vbYesNoCancel + vbQuestion)
                Select Case iResponse
                    Case vbYes: ActiveWorkbook.Names(Split(strNames, "|")(i)).Delete
                    Case vbNo: 'do nothing
                    Case vbCancel: Exit Sub
                End Select
            Next i
    End Select
End Sub

These subs are all fairly intelligent in that they handle the case where just one Named Range resolves to the selection:
One Name

…as well as multiple Named Ranges resolving to the selected range:
rename

So given this code is supposed to do something to Named Ranges that point at the current selection, what happens if someone runs it on a range that no names point at? Glad I asked. It brings up a the inbuilt ‘Name Manager’, in case the user does actually want to do something with a name, but forgot to select the range it resolves to:
Name Manager again

Lastly, here’s Dick’s code that I shamelessly lifted, that lets you create lots of Dynamic Named Ranges from your current selection, in response to a question from GMF. (Now that is a strange name!)

Sub CreateDynamicNames()
   
    Dim rCell As Range
    Dim sCol As String
    Dim sPrefix As String
    Dim strPrompt As String
   
    If TypeName(Selection) = "Range" Then
        strPrompt = "I'll use the headings in the top row to name each range." & vbNewLine & vbNewLine
        strPrompt = strPrompt & "OPTIONAL:  You can enter a prefix below if you want, and I'll use it to prefix each Named Range with." & vbNewLine & vbNewLine
        strPrompt = strPrompt & "Otherwise just push OK, and I'll use the headings as is."
       
        sPrefix = Application.InputBox( _
                Title:="Please input a prefix if you want one...", _
                Prompt:=strPrompt, _
               Type:=2)
            If sPrefix = "False" Then Exit Sub
           
        For Each rCell In Selection.Rows(1).Cells
            If rCell.Value <> "" Then ActiveWorkbook.Names.Add Fix_Name(sPrefix & rCell.Value), "='" & rCell.Parent.Name & "'!" & rCell.Offset(1).Address & ":INDEX('" & rCell.Parent.Name & "'!" & rCell.EntireColumn.Address & ",COUNTA('" & rCell.Parent.Name & "'!" & rCell.EntireColumn.Address & "))"
        Next rCell
    End If
   
End Sub

This code is a real timesaver. Simply select a range that looks like this:
Dynamic Before

…select this from the Right Click menu:
Lightning Fast

…add a prefix if you want:

Some Prefix

…and next time you open NameManager, you’ll see those names are all good to go:

Dynamic After

Pure magic, Dick.

And lastly, here’s Craig Hatmaker’s function I use to clean names:

Public Function Fix_Name(sName As String) As String
 
'   Description:Conforms a string so it can be used as a name
 
'   Parameters: sName       String to be conformed
 
'   Example:    sColumnName = Fix_Name("1st deposit %")
 
'     Date   Ini Modification
'   11/02/10 CWH Initial Programming
'   11/20/10 CWH Used "Like" operator
 
    'If Not DebugMode Then On Error GoTo ErrHandler
    Fix_Name = sName
   
    Dim i As Integer
           
   'Substitute special invalid characters w/standard abbreviations
   sName = Replace(sName, "#", "_NUM")
    sName = Replace(sName, "$", "_AMT")
    sName = Replace(sName, "%", "_PCT")
    sName = Replace(sName, "-", ".")
    sName = Replace(sName, ",", "-")
    sName = Replace(sName, " ", "_")
   
   'Get rid of all other illegal characters
    i = 1
    Do While i <= Len(sName)
        If Not Mid(sName, i, 1) Like "[A-Z,a-z,0-9,.,_,\]" Then _
            sName = Left(sName, i - 1) & Right(sName, Len(sName) - i)
        i = i + 1
    Loop
   
   'First Character cannot be numeric & result cannot look like cell ref.
    If IsNumeric(Left(sName, 1)) Or sName Like "[A-Z]#" Then _
        sName = "_" & sName
 
    Fix_Name = sName
 
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Fix_Name - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
 
End Function

All this is in the attached file, along with some names for you to try it out on. Adjust Named Ranges_20140731

Name-dropper!

In terms of how the above code works, you can find a very good introduction on Ron de Bruin’s site, and you’ll likely learn a lot by poking around Doug Glancy’s site and in the VBA in his MenuRighter and FaceIdViewer addins.

Listing Conditional Formatting Redux

Back in the day, I posted some code to list conditional formatting. It didn’t contemplate having multiple conditional formats for the same range. Because who would ever do that right? Of course that happens all the time and was very short-sighted of me. I aim to atone.

I used a Collection object because Collection objects can’t have two Keys that are the same. It’s a good way to get a unique list out of a list that contains duplicates. I used the range to which the FormatCondition applies as the key (and that was my downfall). My thought was this: I’m checking each cell individually and a FormatCondition that spans two cell would be counted twice. A FormatCondition that applied to L9:M9 would be counted for L9 and M9. By using the address as my unique key, it would only be counted once – the first time for L9 and it would error out and not be counted for M9.

Except you can have two FormatConditions that apply to L9:M9 and only the first would every be counted. I needed a way to identify what was a duplicate and what was a legitimate second FormatCondition. I cleverly devised (read stole from Bob Phillips) that I would add the count to the end of the address. But I got lucky in that it failed for my particular setup. The way my FormatConditions were created, they weren’t in the same order for all the cells. So even though an FC was the same for a later cell, it was the 3rd FC instead of the 2nd, and that made it seem unique.

I set out to find a better way to uniquely identify FCs, and here it is

Public Function CFSignature(ByRef cf As Variant) As String
   
    Dim aReturn(1 To 3) As String
   
    aReturn(1) = cf.AppliesTo.Address
    aReturn(2) = FCTypeFromIndex(cf.Type)
    On Error Resume Next
        aReturn(3) = cf.Formula1
       
    CFSignature = Join(aReturn, vbNullString)
   
End Function

It’s still no guarantee of uniqueness, but if you have two FCs with the same range, the same type, and the same formula, well, you gets what you deserves. Now I can use the ‘signature’ instead of the address.

Public Sub ShowConditionalFormatting()
   
    Dim cf As Variant
    Dim rCell As Range
    Dim colFormats As Collection
    Dim i As Long
    Dim wsOutput As Worksheet
    Dim aOutput() As Variant
   
    Set colFormats = New Collection
   
    For Each rCell In Sheet1.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
        For i = 1 To rCell.FormatConditions.Count
            With rCell.FormatConditions
                On Error Resume Next
                    colFormats.Add .Item(i), CFSignature(.Item(i))
                On Error GoTo 0
            End With
        Next i
    Next rCell
       
    ReDim aOutput(1 To colFormats.Count + 1, 1 To 5)
   
    Set wsOutput = Workbooks.Add.Worksheets(1)
    aOutput(1, 1) = "Type": aOutput(1, 2) = "Range"
    aOutput(1, 3) = "StopIfTrue": aOutput(1, 4) = "Formual1"
    aOutput(1, 5) = "Formual2"
   
    For i = 1 To colFormats.Count
        Set cf = colFormats.Item(i)
           
        aOutput(i + 1, 1) = FCTypeFromIndex(cf.Type)
        aOutput(i + 1, 2) = cf.AppliesTo.Address
        aOutput(i + 1, 3) = cf.StopIfTrue
        On Error Resume Next
            aOutput(i + 1, 4) = "'" & cf.Formula1
            aOutput(i + 1, 5) = "'" & cf.Formula2
        On Error GoTo 0
    Next i
   
    wsOutput.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    wsOutput.UsedRange.EntireColumn.AutoFit
   
End Sub

And in case you forgot, here’s how I got the type.

Function FCTypeFromIndex(lIndex As Long) As String
   
    Select Case lIndex
        Case 12: FCTypeFromIndex = "Above Average"
        Case 10: FCTypeFromIndex = "Blanks"
        Case 1: FCTypeFromIndex = "Cell Value"
        Case 3: FCTypeFromIndex = "Color Scale"
        Case 4: FCTypeFromIndex = "DataBar"
        Case 16: FCTypeFromIndex = "Errors"
        Case 2: FCTypeFromIndex = "Expression"
        Case 6: FCTypeFromIndex = "Icon Sets"
        Case 14: FCTypeFromIndex = "No Blanks"
        Case 17: FCTypeFromIndex = "No Errors"
        Case 9: FCTypeFromIndex = "Text"
        Case 11: FCTypeFromIndex = "Time Period"
        Case 5: FCTypeFromIndex = "Top 10?"
        Case 8: FCTypeFromIndex = "Unique Values"
        Case Else: FCTypeFromIndex = "Unknown"
    End Select
       
End Function

Now this

gets you this

Quickly changing or deleting Named Ranges

One thing that’s always irked me about working with Named Ranges is that while you may have selected the cells that a particular Named Range points at and can even see that name in the Name Box…

NameBox1

…you can’t do anything actually useful to it – such as changing where it points too or deleting it – without first firing up the NameManager, and then rummaging through the haystack for the particular name that you want to amend …

NameManager2

…and then clicking through another damned dialog box…

Edit Name

…or two…
NameManager Refers To

…or three…
Confirm

…purely to change where it points at. Deleting it is nearly as bad, too.

Wouldn’t it be cool if instead of all that rodent-work, you simply pushed some arbitrary keyboard short-cut of your choice, which then told Excel “Hey Excel, I want to resize or delete the Named Range that corresponds to my current selection. Can you do that for me? Can you? Huh?”

And wouldn’t it be cool if Excel then said…

Please select new range

Cool, indeed. File this baby in your Personal Macro Workbook, and trigger it with a keyboard short-cut of your choice:

Sub AmendSelectedName()

Dim nm As Name
Dim strRefersTo As String
Dim rngNew As Range
Dim rngExisting As Range

Set rngExisting = Selection
For Each nm In ActiveWorkbook.Names
    strRefersTo = nm.RefersTo
    If Replace(Replace(strRefersTo, "=", ""), "'", "") = ActiveSheet.Name & "!" & rngExisting.Address Then
        On Error Resume Next
        Set rngNew = Application.InputBox( _
            Title:="Please select new range", _
            Prompt:="Select new range for """ & nm.Name & """ or push Cancel to delete it.", _
            Default:=Selection.Address, _
            Type:=8)
        On Error GoTo 0
        If Not rngNew Is Nothing Then
            nm.RefersTo = "='" & ActiveSheet.Name & "'!" & rngNew.Address
            rngNew.Select
        Else: nm.Delete
        End If
    End If
Next

End Sub

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.