Learning from my Errors

There’s an annoying bug in VBA whereby if you’re trying to change the .visible status of a PivotItem, and if the PivotField had a number format set to General, and if you live in New Zealand, then you’re out of luck:

Unable to set visible property

If you live in the US however, you’ll be fine. No error for you.

Don’t believe me? Either change your Windows region to New Zealand and run this code, or swing down to my place and see it for your own eyes. Here’s where you’ll find me:

247 Rintoul Street

(Aside: Check out those awesome ocean views. Why if it wasn’t for that annoying continent-sized lump of Uranium and Gold Ore off to the West, we’d pretty much have 365 degree views of the entire Pacific. Fortunately they’re busy bulldozing that annoying outcrop and shipping it off to uranium reactors and jewelery stores across the globe. So we should have a completely unfettered view in 2 billion years or so).

Ok, so this issue isn’t just an issue for New Zealanders…it actually affects any place where you haven’t got your Windows ‘region’ set to US, with New Zealand being the only place where I’ve actually encountered such egocentric behavior to date. (I don’t get out much. Or rather, they don’t let me out much. Or rather they make it clear that I can go out, but I can’t come back in.)

According to IronyAaron in the comments at this thread:

When VBA recognizes the dates in the pivot cache, it reads the US version after parsing although the item is read as a locally formatted string. This therefore causes VBA to fail when recognizing Date variables.

Bummer! So write some code that filters PivotItems, and you might find that non-US users have issues, unless they change their regional settings in Windows to US beforehand. Good luck with that.

This nasty bug caused quite a bit of workaround in my FilterPivot routine. I used to do this horrible check on every single item in a potentially exhaustively long list of PivotItems in order to avoid the possibility of an error caused by this unlikely combination occurring:

If Not IsNumeric(Pi.Value) Then
'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
If IsDate(Pi.Value) Then
If Not bDateWarning Then
On Error GoTo ErrHandler
Err.Raise Number:=997, Description:="Can't filter dates"
On Error Resume Next
End If
Else: Pi.Visible = True
End If
Else: Pi.Visible = True
End If

But prompted by Jerry Sullivan’s comment I found that this was only an issue for non-US regional settings, and that this issue is now fixed in Excel 2013. (Thank you, Microsoft. But why the heck didn’t you tell me you’d fixed it?)

So now I can just do this:
pi.Visible = True

Or rather, I could just do that if everyone had Excel 2013. But they don’t. So I can’t. I still have to somehow catch this error. And as written above, my code rather inefficiently looks for possible trouble caused by a combination of things that is probably unlikely to occur. (I mean, how many people would dare to have their Windows region set to a non-US region while trying to filter a PivotItem that happens to be a date in a PivotField that happens to have a General format?) All that preemptive error checking can’t be good for business.

The error of my ways?

I’m sure you’ve already seen what looks to be like the error of my ways… why bother checking for errors just so I can avoid them? Why not embrase them: just plow ahead, and if the s#!t hits the fan, just deal with it. Something like this:

On Error Goto Errhandler
pi.Visible = True

'some other code

ErrHandler:
If Err.Number <> 0 Then
Select Case Err.Number
Case 1004 'Error likely due to bug outlined at http://dailydoseofexcel.com/archives/2013/11/09/a-date-with-pivotitems/
If Not IsNumeric(pi.Value) And IsDate(pi.Value) And pfOriginal.NumberFormat = "General" Then 'Yep, definately that 'Bug
'Note that we need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
i = i + 1
ReDim Preserve strDateItems(1 To i) 'Record the offending things to an array, so we can warn the user about the specific items
strDateItems(i) = pi.Value
End If
Case Else 'Some other error code here
End

Great: now that bug fix code in the Errhandler only gets fired up in the rare event that it is actually triggered. Sure beats neurotically checking each and every PivotItem to see if it might cause an issue.

Unfortunately in this particular case the code snippet in question sits within a larger loop, and the code immediately before needs to have an On Error Resume Next statement applied. That’s because in order to work out whether a PivotItem should be hidden, I’m adding it to a Dictionary object that also contains my desired filter terms, in order to see if it matches any of those filter terms. Which looks something like this:

On Error Resume Next
For Each pi In pfOriginal.PivotItems
dic.Add pi.Value, 1 'The 1 does nothing
If Err.Number <> 0 Then
pi.visible = true
...

So I’d need to put an On Error Goto Errhandler before the pi.Visible = True bit so that my bug fix code in Errhandler would get triggerred, and an On Error Resume Next bit after it, so that the Dictionary test occurs for the very next item. And those will get executed for every single PivotItem – which kind of defeats the efficiency ‘dividend’ of putting my handling code within Errhandler. So I figure I might as well just do this:


pi.Visible = True
If Err.Number = 1004 Then 'Error likely due to bug outlined at http://dailydoseofexcel.com/archives/2013/11/09/a-date-with-pivotitems/
If Not IsNumeric(pi.Value) And IsDate(pi.Value) And pfOriginal.NumberFormat = "General" Then 'Yep, definately that 'Bug
'Note that we need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
i = i + 1
ReDim Preserve strDateItems(1 To i) 'Record the offending things to an array, so we can warn the user about the specific items
strDateItems(i) = pi.Value
End If
End If

Two steps forward, one step backwards.

Maybe I shouldn’t have that On Error Resume Next in there in the first place…maybe I should catch errors from the Dictionary.add in Errhandler too, or even do the dictionary check in another procedure – something that Dick mentions here. Anyone got any advice here?

All I know is that this is a lot of work-around for a combination that is pretty unlikely, but potentially fatal to someone’s analysis.

Pop quiz

Question One

You want to calculate a running (i.e. cumulative) total of the Data column.
Which of these formulas should you put in B2 and drag down, and why?
=SUM(A$2:A2)
=SUM(A2,B1)

Question Two

You want to calculate a running (i.e. cumulative) total of the Data column, and subtract 1 from it.
Which of these formulas should you put in B2 and drag down, and why?
=SUM(A$2:A2)-1
=SUM(A2,B1)-1

—edit—

If you’re ambivalent as to the approach you would take, download and try out a slightly revised thought experiment in the attached file. Then you won’t be ambivalent.

Pop-quiz_20140502-V6

This has a more realistic data set, where instead of subtracting 1 from the cumulative total, you want to subtract a varying list of cumulative expenses, so you can work out the cumulative net profit:
Pop Quiz v5

Take it that inserting/deleting rows is not an issue (assume the structure is locked down).

Note that this is intended to be a thought experiment/illustration about a common approach which happens to be very resource intensive, and a better solution that works just fine provided you don’t do anything else within that formula but calculate a cumulative total.

But feel free to post alternatives.

How do you know if a ListObject has the autofilter applied?

If you try to filter a ListObject, and someone has turned the entire filter off by deselecting the Filter icon from the Data tab, then you’ll get an error. But how the heck can you easily test if the filter is on or not?

If you fire up the macro recorder, and click the Filter icon a few times to toggle it on and off, then you just get this:
Selection.AutoFilter
Selection.AutoFilter
Selection.AutoFilter

You can write If Selection.AutoFilter = TRUE then... but this simply serves to toggle the autofilter from it’s current state, and always returns true.

It seems to me that the only thing you can do is something like this:
Function FilterIsOn(lo As ListObject) As Boolean

Dim bOn As Boolean

bOn = False
On Error Resume Next
If lo.AutoFilter.Filters.Count > 0 Then
If Err.Number = 0 Then bOn = True
End If
On Error GoTo 0
FilterIsOn = bOn
End Function

DataPoint Top and Left for 2007 or earlier.

Over at Datalabel height and width for 2007 or earlier Andy Pope says:

Another couple of properties that are not available prior to 2010 are the Left and Top values of the data point. If you want to know the position of the data point you need to get creative. Having determined the width and height of the data label you can then position the label left/right and above/below and calculate the data point.

Then Jon Peltier says:

Don’t spoil your afternoon moving datalabels around. If it’s an XY chart, then a little algebra goes a long way:
Horiz Position = plotarea.insideleft + plotarea.insidewidth*(X – Xmin)/(Xmax-Xmin)
Vert Position = plotarea.insidetop + plotarea.insideheight*(Ymax-Y)/(Ymax-Ymin)
… with corrections for plotting an axis in reverse order.

If it’s a line chart, the vertical position is as above, the horizontal position uses category number, total number of categories, and a correction for whether the axis crosses on or between categories.

If it’s a bar or column chart, you can get the length of the bar using the above (vert or horiz for column or bar chart), and if it’s stacked you need to sum them up appropriately. The width needs to take into account gap width, and if it’s clustered, how many series there are across each category.

All those potential Select Case statements that Jon will have to use give me the heebie-jeebies. So while I keenly await his forthcoming blog post on how to do things properly, I spent my afternoon being quick and dirty:

Function Pre2010_Position(dl As DataLabel) As String
Dim ptTop As Long
Dim ptLeft As Long
Dim dlLeft As Long
Dim dlTop As Long
Dim dlHeight As Long
Dim dlWidth As Long
Const lngPadding = 7

With dl
dlTop = .Top
dlLeft = .Left

'Determine DL width and height
dl.Left = ActiveChart.ChartArea.Width
dlWidth = ActiveChart.ChartArea.Width - dl.Left
dl.Top = ActiveChart.ChartArea.Height
dlHeight = ActiveChart.ChartArea.Height - dl.Top

dl.Position = xlLabelPositionRight
If dl.Left + dlWidth = ActiveChart.ChartArea.Left + ActiveChart.ChartArea.Width Then
'Datalabel is too wide to fit between point and plot edge
dl.Position = xlLabelPositionLeft
ptLeft = dl.Left + dlWidth + lngPadding
Else:
ptLeft = dl.Left - lngPadding
End If

dl.Position = xlLabelPositionBelow
ptTop = dl.Top - lngPadding
DoEvents
dl.Position = xlLabelPositionAbove
DoEvents
If dl.Top + dlHeight + lngPadding > ptTop Then ptTop = dl.Top + dlHeight + lngPadding

'Return DataLabel to original position
.Top = dlTop
.Left = dlLeft
End With
Pre2010_Position = dlWidth & "|" & dlHeight & "|" & ptLeft & "|" & ptTop

End Function

To test this, just select a DataLabel and run this:

Sub test()
Dim strPosition As String
Dim dl As DataLabel
Set dl = Selection

strPosition = Pre2010_Position(dl)

Debug.Print "dlWidth: " & Split(strPosition, "|")(0)
Debug.Print "dlHeight: " & Split(strPosition, "|")(1)
Debug.Print "ptLeft: " & Split(strPosition, "|")(2)
Debug.Print "ptTop: " & Split(strPosition, "|")(3)

End Sub

Note that I’ve got a couple of DoEvents in the Pre2010_Position routine. Without them, on my 2013 install it just doesn’t seem to work properly unless you step through the code one line at a time. Tedious, and annoying because you can see everything moving on the graph. But unavoidable, it seems. And tracking this down was what took the most time. Very frustrating.

For instance, without the DoEvents I get this:
dlWidth: 102
dlHeight: 51
ptLeft: 83
ptTop: 97

…whereas with them, I get this:
dlWidth: 102
dlHeight: 51
ptLeft: 83
ptTop: 64

Here’s my revamped LeaderLines file. Anyone with 2007 or earlier fancy taking this for a spin, and advising if it works?
Leader-lines_20140225-v10

Datalabel height and width for 2007 or earlier.

Over at Chart LeaderLines in Excel 2010 or earlier I posted some code that draws leader-lines on charts just like Excel 2013 does.

Unfortunately that title was misleading in regards to the or earlier bit: Eric said that the code isn’t working at all in XL07, and Jon Acampora advised that the DataLabel.Height and DataLabel.Width properties are not available in XL07.

Andy Pope had a crafty workaround for this:

The trick to getting datalabel width and height is to force the data label off of the chart by setting left and top to chartarea width and height. The data labels will not actually go out of the chart so by reading the new left and top properties you can calculate the differences.

So I whipped up some functions to get the datalabel height and width:

Function dlHeight_2010(dl As DataLabel)
dlHeight_2010 = dl.Height
End Function

Function dlWidth_2010(dl As DataLabel)
dlWidth_2010 = dl.Width
End Function

Function dlHeight_Pre2010(dl As DataLabel)
Dim dlTop As Long
dlTop = dl.Top
dl.Top = ActiveChart.ChartArea.Height
dlHeight_Pre2010 = dl.Top - ActiveChart.ChartArea.Top
dl.Top = dlTop
End Function

Function dlwidth_Pre2010(dl As DataLabel)
Dim dlleft As Long
dlleft = dl.Left
dl.Left = ActiveChart.ChartArea.Width
dlwidth_Pre2010 = dl.Left - ActiveChart.ChartArea.Left
dl.Left = dlleft
End Function

They are all separate functions because if I lumped them together in one, it wouldn’t compile on pre-2010 machines. So I call these from the main code with this:
If Application.Version = 14 Then
dlHeight_2010 dl
dlWidth_2010 dl

ElseIf Application.Version < 14 Then dlHeight_Pre2010 dl dlwidth_Pre2010 dl End If

I've updated my leaderlines code to use these. If I comment out the stuff relating to 2010 and force Excel to use the pre2010 functions then it seems to work perfectly. But I asked a buddy to try it in his 2007 installation, and he advises that it doesn't work...it just deletes the chart leader lines without redrawing them.

Anyone with 2007 or earlier fancy taking this for a spin, and advising where I might have gone off the rails?

Mucho Gracious.
Leader lines_20140225 v7

Data Validation doesn’t care about volatility.

Huh. All these years I’ve been telling people to avoid volatile functions in models – especially in dropdowns because large chains of dependents usually hang off of these – and it turns out that I’m wrong in that specific case, as per Roberto’s comment in this thread.

If you use a volatile function to feed data validation, then the formulas downstream of that data validation cell only get recalculated when you select something new from the dropdown. That is, it behaves just like a non volatile function.

Goodbye clunky INDEX-based cascading dropdowns. Hello INDIRECT and OFFSET-driven cascading dropdowns.

Instant Pivot: Just Add Water

Ahem.

BEHOLD!


Sub InstantPivot()

' InstantPivot: Just Add Water
' Assign this to Ctrl + Shift + P or something like that.

' Description: * Turns selection into Excel ListObject
' * Makes a Pivottable out of it at the edge of the used range
' * Applies my preferred default settings
' * Selects the Pivot and cuts it, so that
' Dick Kusleika can then use arrow keys
' and Control + V to paste it where he wants
' without having to touch that unclean dusty rodent
' he keeps at the edge of his Desk.Usedrange
'

'Here's the settings it applies.
' 1. Changes the Report Layout to "Show in Tabular Form"
' 2. Turns on "Repeat All Item Labels" option
' 3. Turn off Subtotals
' 4. Turn off Grand Totals
' 5. De-selects the Row Headers option from the Design tab.
' 6. Turns off 'Autofit Column Width on Update'
' 7. Adopts the source formatting

' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz

' Name/Version: Date: Ini: Modification:
' InstantPivot 20140213 JSW Initial programming
' InstantPivotV2 20140216 JSW Added error handler and check for multiple cells
' InstantPivotV3 20140216 JSW Adopted SNB's approach of setting numberformat while turning subtotals off
' InstantPivotV4 20140216 JSW If run on existing pivot that is not based on ListObject, turns source into ListObject
' InstantPivotV5 20140216 JSW Now ignores Values fields and doesn't apply format if pf.function = xlCount
' InstantPivotV6 20140324 JSW Had accidentally left out With Application stuff at the start

' Inputs: None

' Outputs: PivotTable is formatted accordingly

Dim pc As PivotCache
Dim pf As PivotField
Dim pt As PivotTable
Dim lo As ListObject
Dim rng As Range
Dim strLabel As String
Dim strFormat As String
Dim i As Long
Dim wksSource As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With

On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo errhandler
If pt Is Nothing Then
Set lo = ActiveCell.ListObject
If lo Is Nothing Then Set lo = ActiveSheet.ListObjects.Add(xlSrcRange, Selection.CurrentRegion, , xlYes)
Set rng = Cells(ActiveSheet.UsedRange.Row, ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column + 1)
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo)
Set pt = pc.CreatePivotTable(TableDestination:=rng)
Else:
'Check if pt is based on a ListObject.
' * If so, set lo equal to that ListObject
' * If not, turn that source data into a ListObject
On Error Resume Next
Set lo = Range(pt.SourceData).ListObject
On Error GoTo errhandler
If lo Is Nothing Then
Set rng = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
Set wksSource = rng.Parent
Set lo = wksSource.ListObjects.Add(xlSrcRange, rng, , xlYes)
pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo.Name)
End If

End If

With pt
.ColumnGrand = False
.RowGrand = False
.RowAxisLayout xlTabularRow
.RepeatAllLabels xlRepeatLabels
.ShowTableStyleRowHeaders = False
.ShowDrillIndicators = False
.HasAutoFormat = False
.ManualUpdate = True
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = 1 To .PivotFields.Count - .DataFields.Count 'The .DataField.Count bit is just in case the pivot already exists
Set pf = .PivotFields(i)
With pf
If pf.Name <> "Values" Then
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
On Error Resume Next
.NumberFormat = lo.DataBodyRange.Cells(1, i).NumberFormat
On Error GoTo errhandler
End If
End With
Next i
End If
End With

' Get DataFields to match the formatting of the source field
' Note that this will only be neccessariy in the case that we're
' running this code on an existing pivot
On Error GoTo errhandler
If pt.DataFields.Count > 0 Then
For Each pf In pt.DataFields
If pf.Function <> xlCount Then pf.NumberFormat = pt.PivotFields(pf.SourceName).NumberFormat
' Do away with 'Sum of' or 'Count of' prefix etc if possible
On Error Resume Next
pf.Caption = pf.SourceName & " "
On Error GoTo errhandler
Next pf
End If

'This needs to go before the .Cut bit, otherwise the .Cut stack gets wiped
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With

With pt
.ManualUpdate = False
.TableRange2.Select
.TableRange2.Cut
End With
Err.Clear
errhandler:
If Err.Number > 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
MsgBox "Whoops, there was an error: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End If
End Sub

Begone, Carpal Tunnel Syndrome.

Thanks for nothing, ListObject

Why is it that you can do this:

Dim lo as ListObject
Set lo = ActiveCell.ListObject
If lo Is Nothing Then 'Do something

…but you can’t do this:

Dim pt as PivotTable
Set pt = ActiveCell.PivotTable
If pt Is Nothing Then 'Do something

…and instead you have to do this:

Dim pt as PivotTable
On Error Resume Next
Set pt = ActiveCell.PivotTable
If Err.Number > 0 then 'Do something
Err.clear

Huh? Huh?