One of these things is not like the other…

Sometimes when I copy code from the web and paste it into VBA, I get something like this:
 
Error
 

…and I’m damned if I know why. It’s not the usual culprit of incorrect quote marks. It’ something else, and I don’t know what.

Usually I just retype the offending line:
 
No error
 
…and after looking in vain for a difference, simply delete the bad one, and put it down to inexperience.

But not today. Because I’m tired of being compiled around. So today, I’m gonna find out why. And I’m going to use Excel to keep VBE honest. Conquer and #DIV/0, I say.

If I paste the two formulas into separate cells in Excel, then I can clearly see that something is amiss. I just can’t clearly see the actual something:
 
Excel 1
 

Okay, let’s get nasty, and atomise these suckers so I can compare their DNA:
=MID(A,ROW(A1:INDEX(A:A,LEN(A))),1)
=MID(B,ROW(B1:INDEX(B:B,LEN(A))),1)

Array
 

Well take a look at that…there’s the culprit:
 
False
 
No wonder I couldn’t see it:
 
Different

In this particular case, the culprit looks like Ken Pul’s Blog platform…I stole the code from a comment Jan Karel left there, and note that the code has no similar issue if I lift it directly from Jan Karel’s site.

There you go. Busted.

Makes me feel like singing:

Singing

Slicers and SlicerCaches

Behind the scenes, Excel does quite a bit of smart rationalisation in terms of SlicerCaches whenever you connect Slicers to mulitple PivotFields, and this can be a bit confusing if you’re not familiar with what’s going on. So let’s take a look-see.

First, let’s create three PivotTables all based on the same data source – meaning they all share the same PivotCache and therefore can all be connected – or ‘daisy-chained’ – together with Slicers later on if we so desire:
 
Three Pivots One Cache

Next, let’s add a separate Slicer for each of them, with each Slicer pointed at the “Item” field of it’s related Pivot:
 
Slicers and Pivots only
 
 
So that’s what we see. How does Excel see this?

Seperate SlicerCaches

There’s a couple of points to note about this diagram. Firstly, the boxes across the top are screenshots from the Report Connections dialog box:
 
ReportConnections

…which you get by right-clicking on a Slicer and selecting this:
 
ReportConnections< And secondly, the reason I've drawn circles around those Item fields:   PivotField level

…is that I really want to underscore that slicers operate at the PivotField level, not on PivotTable level.
 
So where where we. Ah yes, three Pivots based on the same PivotCache, with three Slicers all pointing at the Item field of their respective PivotTable:
 
Seperate SlicerCaches

Let’s now change Slicer Two so that it also points at the Item field of PivotTable Three:
 
ReportConnections - both
 
How did that change the conceptual lay of the land?
Shared SlicerCaches2

 
Well, that looks different. Excel rationalised the SlicerCaches by ditching SlicerCache three, and now both Slicer Two and Slicer Three are connected to SlicerCache Two. Meaning that conceptually, they both point at the Item field in both PivotTable2 and PivotTable3. In fact, if you were to right click Slicer Three and look at the ReportConnecitons, you’d see it looks exactly the same as for Slicer 2, even though we didn’t touch it. And if we change the selection in one of these Slicers, we see it replicated in the other as well as in each Pivot. It’s as if those Slicers are one and the same:
One and the same
 
Interestingly, if we remove PivotTable3 from that SlicerConnections dialog:
 
ReportConnections - remove 3
 
…things don’t go back to the way before: Slicers Two and Three are still synced together, but control PivotTable2 only. PivotTable3 is completely slicer-less:
 
Remove PT3  from Slicer Two

There’s no way you can get that Slicer Three to operate independently on its own again. You’ll just have to delete it and add another, I’m afraid.

Adding Slicers Programatically

 
If you record a macro while adding a slicer, you get code like this:

ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables(“PivotTable1”), “SomePivotField”). _
Slicers.Add ActiveSheet, , “SomePivotField”, “SomePivotField”, 146.25, 309.75, 144, 187.5

All those arguments of the Slicers.Add command are optional except the first. And all those numbers just tell Excel where you want the Slicer, and how big you want it to be. So you could just go ahead and use this for the same result:

ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables(“PivotTable1”), “SomePivotField”). _
Slicers.Add ActiveSheet

You can actually add a SlicerCache that controls a pivot without adding a Slicer:
ActiveWorkbook.SlicerCaches.Add ActiveSheet.PivotTables("PivotTable1"), "SomePivotField"

…and then you can connect another PivotTable to it:
ActiveWorkbook.SlicerCaches("Slicer_SomePivotField").PivotTables.AddPivotTable (ActiveSheet _
.PivotTables("PivotTable2"))

…meaning you now have an invisible slicer that keeps the pivots in sync, based on user selections from the pivot filters themselves. Spooky! Note that –

  • If you add another slicer to that same PivotField on either of those PivotTables, Excel simply uses the slicer cache you just set up, meaning the new slicer controls BOTH pivots, even though you just added it to one.
  • If you delete that slicer, Excel performs a Slicer Exorcism: it deletes the underlying SlicerCache, meaning your two pivots are no longer synced. Unspooky!

Here’s something else slightly spooky. Or rather, kooky. Normally if you delete a pivot that is the ONLY pivot that uses a particular PivotCache, Excel gets rid of the PivotCache automatically. Excel basically thinks “Well, we won’t need that crap lying around anymore”. But strangely, if you have a slicer set up for that pivot, then deleting the pivot leaves both the slicer AND the pivot cache alone. The PivotCache only gets deleted once you delete that orphaned slicer.

Well, that’s enough for today. But *HORROR* there’s some Slicer-related sequels coming to a screen near you soon:
 
Nightmare

So stay tuned. And awake.

Formulas? Pah!

Welcome back to Twice Daily Dose of Excel. Heck, these days we’re more regular than Julian Assange’s visits to the Ecuadorian Embassy!

Audrey has a table that looks something like this (if you’re American):

Table US

…or like this (if you live somewhere sensible, like in New Zealand and a good deal many other places besides):

Table English

She uses this to track when she requested a piece of information from someone, and the date she received a response. I’m picking she’s NSA, and is asking Julian – who is actually a quadruple agent – whether he needs more sun lamps. Stranger things have happened, recently.

Anyways, she’d like a formula to find the oldest/latest request date out of all responses received in a particular month.

She could array enter something like this, which will do the job without any need for helper columns:

=MAX($A$2:$A$20*(DATE(YEAR($B$2:$B$20),MONTH($B$2:$B$20),1)=DATE(YEAR($B2),MONTH($B2),1)))

…which to an Excel Pro with a lifetime of formulas under their belt would look like this:

=NOT(RocketScience)

…but to anyone else:
="Αυτό θα μπορούσε κάλλιστα να είναι γραμμένο στην ελληνική γλώσσα"

You could debate whether there’s a right formula to use in a situation like this. In fact there’s some great debate on that original blogpost as to whether one proposed solution is awesome, potentially obfuscating, or incomprehensibly mutant. So with this in mind, is there a right formula to use in this case? Depends on who’s trying to comprehend what’s happening here in 6 months time. Perhaps yourself, with six more months of grey-matter dieback under your belt. Or hat, rather. Is there a right non-formula approach to Audrey’s problem? You betcha:

Just create a PivotTable out of that sucker:

Blank PivotTable

…drag the ‘Date Received’ field to the Rows pane and the ‘Date Requested’ field to the Values pane:

PivotTable

…launch the Value Field Settings dialog for the Date Requested field:

Launch Value Field Settings

…change the name of the Date Received field to something meaningful, and change Sum to Max:

Value Field Settings Dialog

…plus click on that Number Format button while you’re there so you can change the format to Date:

Number Format

…then select any cell in the Date Received column and click Group Selection from the PivotTable Tools > Analyze contextual tab, and group by Months and Years:

Group Selection

…and exhale:

Pivot

No, waithold that breath…we forgot to change the name of that ‘Years’ column that just appeared – as well as the ‘Date Received’ column that now holds Months only – to something more suitable:

Pivot finished

Now exhale.

Here’s the genius…it even works in American:

Pivot finished american

and it works on trickier problems, like the original one at that post:

Original Problem

 
¿Fórmulas? No nos hacen falta fórmulas apestosas!

Dynamic Vertical Line on a ScatterPlot

GMF comments:

I use XY charts for schedules and I like to have a vertical line showing today’s date. I do this so frequently I have a named range for each of the X and Y values. To get the current date to show up as 2 similar X values the best I could come up with is:

=(ROW(INDIRECT(“1:2″))/ROW(INDIRECT(“1:2″)))*TODAY()

There must be a better way, but I can’t just put ={TODAY(),TODAY()} as a value and I’m curious why.

Until somebody smart like Charles Williams jumps in with a better explanation, the reason you can’t put individual functions into an array is that you can’t. I know, it sucks. I’d like to be able to do that too.

Edit: Colin Legg beat Charles to it:

When you use { } within a formula they are delimiters for an array constant. The formula parser won’t let you embed functions or references within an array constant because, by definition, the elements wouldn’t be constant anymore.

That said, you can get there indirectly:
=TODAY()*{1,1}
={41854,41854}

Sure Jeff, but I want to be able to put different functions in each array position.

Not a problem…with a bit of cleverness, you can do the equivalent of this:
={MIN(SomeRange),Max(SomeRange)}

…like this:
=MIN(SomeRange)*{1,0}+MAX(SomeRange)*{0,1}

…which says to Excel:

  • Populate a 2-element array with the minimum of SomeRange, but multilpy the first element by 1 and the second element by 0, in order to clear the minimum from that second element.
  • Populate a 2-element array with the maximum of SomeRange, but multilpy the first element by 0 and the second element by 1, in order to clear the maximum from that first element.
  • Add them together, leaving just the minimum in the first, and the maximum in the second.

 
 

So how does this tie in with what GMF wants to do, i.e. put a vertical line in an XY chart to show the current date?
 
Chart

Well, because this is an XY chart, you only need two coordinates to draw that date line line: the point at the bottom, and the point at the top.

So to get the X values we want – today’s date, we define a name called Today:
=TODAY()*{1,1}
And for the Y values – the Min and Max values across both ‘Values’ series – we define a name called MinMax:
=MIN(SomeRange)*{1,0}+MAX(SomeRange)*{0,1}

And then we can add a new series called Today to our chart:
 
SelectDataSource

…with the X and Y coordinates of that series pointing at the appropriate name:
 
EditSeries

Of course, you don’t actually need a Named Range to do this… you can simply have some helper cells in the actual worksheet that calculate the Min and Max values of the entire block of data, and point your Today series at that:
 
Chart - non array2

Here’s a sample file with both approaches: Todays Date on ScatterPlot

Maybe this stuff is all included in Dick and Mike’s book 101 Ready-To-Use Excel Formulas. I don’t know…I’m still waiting for my free advance copy in the post.

Well, that’s all folks. Hopefully this post moved those lines on the chart closer together rather than pushing them apart.

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
On Error Resume Next
If nm.RefersToRange.Address(External:=True) = rng.Address(External:=True) Then
If Err.Number = 0 Then strNames = strNames & nm.Name & "|"
End If
On Error GoTo 0
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.Name:=strNew
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 """ & nm.Name & """?"
iResponse = MsgBox( _
Title:="Multiple Names Found", _
Prompt:=strMessage, _
Buttons:=vbYesNoCancel + vbQuestion)
Select Case iResponse
Case vbYes: nm.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_20140801

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.

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 = "Filter" Or strLastUndoStackItem = "Slicer Operation" Then
strPivotChange = PivotChange_LayoutComparison(Target, strVisibleItems)
If strPivotChange = "" Then strPivotChange = PivotChange_EliminationCheck(Target, strPossibles)
If strPivotChange = "" Then strPivotChange = PivotChange_UndoCheck(Target, strPossibles)
Target.Summary = strVisibleItems
If strPivotChange <> "" Then MsgBox strPivotChange
Else:
MsgBox strLastUndoStackItem
End If

End Sub

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

Here’s the sample file: PivotChange_20140802

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_20140802

 
Test Pattern

Update

I have re-factored the code in the sample file as per the post at Broken Arrow.