NOT learning from my Errors

I was writing some formulas today that need to return TRUE if a search term appears in a cell, and FALSE otherwise. For instance, I wanted to know if FOO appeared in FOOBAR or not.

Originally I was using FIND, along these lines:

But then had some issues with case that screwed things up:

Given that for my purposes FOO was as good as Foo, I decided to replace the FIND function in this with the SEARCH function, on account of SEARCH being an insensitive bastard. (Can I say that here? No? Oops…sorry!).

So I manually edited the formula, and replaced FIND with SEACH. Then cut and pasted that formula in lots of other places. Then did lots of analysis with the output. Without learning from the error of my ways:

Whoops…that’s not how you spell SEARCH! Why didn’t you tell me Excel? Oh…because of this:

Which don’t mean there ain’t no FOO (or Foo) to be found. Rather it means “Yes, I am in fact returning an error – thank you for asking – because I have no idea what this damn SEACH does.”

Murphy’s law: I never noticed that I’d screwed it up until right at the very end of my days work.

Still, not noticing till the very end is better than not noticing.

Or as Excel would put it:
=NOT(ISERROR(SEARCH(“not noticing”,”not noticing till the end is better than not noticing.”)))

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

If Err.Number <> 0 Then
    Select Case Err.Number
    Case 1004 'Error likely due to bug outlined at
        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

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
    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.

Wonky Keyboard Shortcut

Check out the keyboard shortcut for the Reapply button.

I don’t think I’ve ever used that button. If I need it, I think I’ll just use the mouse. Even I have limits.

Find Your Dropbox Folder in VBA

Here’s a function to get the location of the Dropbox folder:

Public Function DropBox() As String
    Dim DropboxHostFile As String
    Dim DropboxHostFileNumber As Long
    Dim Base64EncodedPath As String
    Dim TempXMLDocument As MSXML2.DOMDocument60
    Dim Base64XMLNode As MSXML2.IXMLDOMElement
    DropboxHostFile = Environ("appdata") & "\Dropbox\host.db"
    DropboxHostFileNumber = FreeFile
    Open DropboxHostFile For Input As DropboxHostFileNumber
    Base64EncodedPath = Input$(LOF(DropboxHostFileNumber), DropboxHostFileNumber)
    Close DropboxHostFileNumber
    Set TempXMLDocument = New MSXML2.DOMDocument60
    Set Base64XMLNode = TempXMLDocument.createElement("b64")
    Base64XMLNode.DataType = "bin.base64"
    Base64XMLNode.Text = Split(Base64EncodedPath, vbLf)(1)
    DropBox = StrConv(Base64XMLNode.nodeTypedValue, vbUnicode)
End Function

According to Reinaldo there is a host.db file in the Roaming directory that stores this information. The Environ("appdata") function returns the Roaming directory in Win7. I open host.db and read in the text. Then I create a new XML document, thanks to Tim Hastings, to write in the Base64 text and read out the byte data that is converted to Unicode. There’s two lines in my host.db file, so I split on vbLf and only use the second line.

Here’s what it would look like if I wrote this function and didn’t want to poke my eyes out afterward.

Public Function DropBox() As String
    Dim sFile As String
    Dim lFile As Long
    Dim sPath As String
    Dim xDoc As MSXML2.DOMDocument60
    Dim xNode As MSXML2.IXMLDOMElement
    sFile = Environ("appdata") & "\Dropbox\host.db"
    lFile = FreeFile
    Open sFile For Input As lFile
    sPath = Input$(LOF(lFile), lFile)
    Close lFile
    Set xDoc = New MSXML2.DOMDocument60
    Set xNode = xDoc.createElement("b64")
    xNode.DataType = "bin.base64"
    xNode.Text = Split(sPath, vbLf)(1)
    DropBox = StrConv(xNode.nodeTypedValue, vbUnicode)
End Function

Visualizing Podcasts

I like podcasts. I listen to them almost every minute I’m behind the wheel. They’re mostly technology related, so if my wife’s in the car sometimes I have to turn on music or switch to Unprofessional or Roderick on the Line (a couple of great podcasts that are a little less techy). As I was listening to the most recent Stackexchange podcast, I thought it would be interesting to visualize the conversations in three of my favorite podcasts.

Accidental Tech Podcast: Casey opens and closes the show. He gets some words in in the middle, but they’re two small to register at this scale (unless the topic is vinyl records). Marco does the ad reads and discusses coffee and headphones and John does the rest.

Roderick on the Line: Merlin primes the pump, but once John gets rolling there’s no stopping him.

Stackexchange: Sometimes they have a guest and it’s slightly less chaotic.

Of course these charts are made in jest and do not reflect actual data or any ill will toward the podcasters. They are three of my favorite podcasts and I never fail to listen to miss them. If you like podcasts, I recommend them (and even if you don’t).

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?

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?


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.


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.

Copy Selection Sum to Clipboard

Last month I posted some metrics on the keyboard shortcuts I use. One of the pieces of code that I could not link to (because I’ve never posted it) is CopySum. I don’t remember what prompted me to write this little procedure, but it has been surprisingly useful. It sums the selected cells and puts that sum into the clipboard. That’s all it does.

Sub CopySum()
    Dim doClip As MSForms.DataObject
    On Error Resume Next
    gclsAppEvents.AddLog "^+c", "CopySum"
    Set doClip = New MSForms.DataObject
    If TypeName(Selection) = "Range" Then
        doClip.SetText Application.WorksheetFunction.Sum(Selection)
    End If
End Sub

If I want to get a one-off sum of something and use it in another program, this comes in handy. I could SUM in a cell, copy that cell, paste it, and delete it. If I paste into Notepad, it’s fine, but if I try to paste into Outlook or even Gmail those programs try to get fancy and make an HTML table. Sometimes I just want the text.

One shortcoming of this procedure is that it doesn’t do well with filtered cells. The Selection includes both visible and hidden cells, but I probably only want visible. I’m changing the code to

doClip.SetText Application.WorksheetFunction.Subtotal(9, Selection)

so it works with filtered data.

Where to Find Data

Of course I use my sample data generator when I need some sample data. But sometimes I want some real data. I looked high and low for data sources to include in the upcoming 101 Ready to Use Excel Formulas book that Mike and I are writing. If you like data as much as I do, there might be a few sources you haven’t found on my pinboard page.

If you have a good one that’s not on that page, leave it in the comments.

Printing Labels on a Dymo LabelWriter 450 from VBA

How’s that title for Google-ability. Pretty saucy, I’d say. Here’s an affiliate link if you’re in the market for one of these label printers.

LabelWriter 450

Back in 2010, I was printing labels on a Dymo from VBA. At my current job, I had occasion to do it again, so I bought a LabelWriter 450 from Amazon. Seventy-five bucks! What a deal.

Previously I didn’t need anything fancy formatting-wise. I could just push some text at a DymoLabels object and print it. I’m not so lucky this time around. I really needed some underlines for visual separation of data. I don’t see any way to underline stuff through the Dymo object model. But what I did discover was that the .label files created by their software are just XML files. Woot!

Rather than trying to navigate a klunky object model, I can just write to a text file. Here’s what the new labels look like.

And here’s a piece of the XML file.

                    <String>Int BOL  Ext BOL     Gallons   Price        Total
                        <Font Family="Courier New" Size="10" Bold="True" Italic="False" Underline="True" Strikeout="False" />
                        <ForeColor Alpha="255" Red="0" Green="0" Blue="0" />
                    <String>         22753         6,418   2.9775   19,109.60
18318    24094018        830   3.3361    2,768.93
18318    0           </String>
                        <Font Family="Courier New" Size="10" Bold="True" Italic="False" Underline="False" Strikeout="False" />
                        <ForeColor Alpha="255" Red="0" Green="0" Blue="0" />

The XML isn’t terribly pretty mostly because there are line feeds in there. Without the line feeds, I think it would be indented properly. Each Element tag has a String tag and an Attributes tag. It looks like every font attribute is listed whether you specifically set it or not. I’m also padding my text with spaces to line up columns. I could use multiple text boxes, but there is no grid control. For now, this works. The only downside to using one big textbox and space padding is that I have to use a fixed-width font – Courier New in this case. If I want to use a nicer font, I’ll have to go the multiple textbox route.

I have this form for data input and a button to print the label. The button kicks off the code below. I don’t need the mdyLabel variable any more because I’m not using that part of the object model. Instead of mdyLabel, I’m manipulating the XML file directly giving me more control.

Sub PrintBlendCalc()

    Dim vaPrinters As Variant
    Dim i As Long
    Dim sFile As String
    Const sMSGNODYMO As String = "Dymo label printer not found."
     If mdyAddin Is Nothing Then
     End If
     If Not mdyAddin Is Nothing Then
         vaPrinters = Split(mdyAddin.GetDymoPrinters, "|")
         For i = LBound(vaPrinters) To UBound(vaPrinters)
             If mdyAddin.IsPrinterOnline(vaPrinters(i)) Then
                 mdyAddin.SelectPrinter vaPrinters(i)
                 Exit For
             End If
         Next i
         UpdateLabelFile sFile
         mdyAddin.Open sFile
         mdyAddin.Print2 1, True, 1
         MsgBox sMSGNODYMO, vbOKOnly
     End If

End Sub

Instead of using the SetField method (like in the previous example), I call a new procedure called UpdateLabel file to create a new XML file. Then I open the file and print it.

Public Sub UpdateLabelFile(ByRef sFile As String)
    Dim xDoc As MSXML2.DOMDocument
    Dim xStrings As MSXML2.IXMLDOMSelection
    Dim vaData As Variant
    'Get the label data in an array
    vaData = wshBlendCalc.Range("B2").Resize(7, 5).Value
    'Create a new XML Doc and load the template label
    Set xDoc = New MSXML2.DOMDocument
    xDoc.Load msLABELPATH & "BlendCalc.label"
    'Get all the "String" elements (there are 4)
    Set xStrings = xDoc.getElementsByTagName("String")
    'Change the text of the four string elements
    xStrings(0).Text = FormatLabelText(vaData, 1)
    xStrings(1).Text = FormatLabelText(vaData, 2) & FormatLabelText(vaData, 3)
    xStrings(2).Text = FormatLabelText(vaData, 4)
    xStrings(3).Text = FormatLabelText(vaData, 5) & FormatLabelText(vaData, 6) & FormatLabelText(vaData, 7)
    'Save the XML file
    sFile = msLABELPATH & "NewOrders\" & vaData(2, 2) & "_blend.label"
    xDoc.Save sFile
    'Save the data to a text file for those people who don't read XML that well
    Open msLABELPATH & "NewOrders\" & vaData(2, 2) & "_blend.txt" For Output As #1
    Print #1, FormatLabelText(vaData, 1) & _
        FormatLabelText(vaData, 2) & _
        FormatLabelText(vaData, 3) & _
        FormatLabelText(vaData, 4) & _
        FormatLabelText(vaData, 5) & _
        FormatLabelText(vaData, 6) & _
        FormatLabelText(vaData, 7)
    Close #1
End Sub

There are four elements in my XML file. The first label line is underlined, so that gets its own element. The second and third lines and a portion of the fourth line have the same attributes, so they’re grouped into one element. The portion of the fourth line that is underlined is in the third element. And all the rest of the text goes into the fourth element. The elements are set and the attributes are just the way I want them, so all that is left is to update the text.

I pass the array into a FormatLabelText function which extracts the data I want and pads the spaces so the columns line up. The FormatLabelText function is shown below.

I pass the sFile variable ByRef into UpdateLabelFile. The sFile variable is set and retains that value back in the calling procedure so the calling procedure knows which file to open and print.

The FormatLabelText function takes the array and whichever row we’re interested in formatting. It starts by defining three arrays: vaBuffer defines how much padding for each of the five columns; vaAlignLeft defines if the columns are aligned right or left; and vaFormat defines the number format for each of the five column (@ is the format for general text).

Public Function FormatLabelText(ByRef vaData As Variant, ByVal lIndex As Long) As String
    Dim sReturn As String
    Dim vaBuffer As Variant
    Dim vaAlignLeft As Variant
    Dim vaFormat As Variant
    Dim sData As String
    Dim j As Long
    vaBuffer = Array(9, 11, 11, 8, 10)
    vaAlignLeft = Array(True, True, False, False, False)
    vaFormat = Array("@", "@", "#,##0", "0.0000", "###,##0.00")
    For j = LBound(vaData, 2) To UBound(vaData, 2)
        sData = Format(vaData(lIndex, j), vaFormat(j - 1))
        If Len(sData) = 0 Then
            sData = Space(vaBuffer(j - 1))
        ElseIf Len(sData) > vaBuffer(j - 1) Then
            sData = Left$(sData, vaBuffer(j - 1) - 1) & Chr$(133)
        ElseIf Len(sData) < vaBuffer(j - 1) Then
            If vaAlignLeft(j - 1) Then
                sData = sData & Space(vaBuffer(j - 1) - Len(sData))
                sData = Space(vaBuffer(j - 1) - Len(sData)) & sData
            End If
        End If
        sReturn = sReturn & sData
    Next j
    FormatLabelText = sReturn & vbNewLine
End Function

First the data is formatted using the Format function and the vaFormat array. Next, the big If..ElseIf..EndIf block determines how to pad the data with spaces.

  • If the data is empty (Len = 0) then write spaces for the whole buffer.
  • If the data length is greater than the buffer, truncate it and add an ellipse to the end.
  • If the data length is less than the buffer, add spaces to the end (or the beginning if it’s aligned right) to fill it out.

It would be nice (but hard) to create a more general purpose function that created a label from a range. But this works for now.

KwikOpen Addin

I’ve been using this recent files userform for quite a while now and I like it. I haven’t added Eric’s comment yet (and for no good reason), but I’m going to in the next version. I don’t know if that solves the Sharepoint problem or just the ChDrive problem as neither are problems for me.

Here are my two problems:
Not enough recent files. I’m shocked – SHOCKED – at how often 50 recent files is not enough. It’s usually when I have to open a whole bunch of very similar files that I will never open again, but that clean out my recent files list. I decided to, sort of, maintain my own list. Because I use class modules *ahem* changing things to maintain my own list was pretty easy. I had to change how I fill the CRcntFiles class, but everything that consumes that class downstream just works. Here’s the new Fill method in CRnctFiles.

Public Sub Fill()
    Dim rf As RecentFile
    Dim clsRcntFile As CRcntFile
    Dim sFile As String, lFile As Long
    Dim vaFiles As Variant
    Dim i As Long
    For Each rf In Application.RecentFiles
        Set clsRcntFile = New CRcntFile
        clsRcntFile.FullName = rf.Path
        Me.Add clsRcntFile
    Next rf
    sFile = ThisWorkbook.Path & Application.PathSeparator & msMRUFILE
    lFile = FreeFile
    Open sFile For Input As lFile
    vaFiles = Split(Input$(LOF(lFile), lFile), vbNewLine)
    Close lFile
    For i = LBound(vaFiles) To UBound(vaFiles)
        If Len(vaFiles(i)) > 0 Then
            Set clsRcntFile = Nothing
            Set clsRcntFile = Me.RcntFileByFullName(vaFiles(i))
            If clsRcntFile Is Nothing Then
                Set clsRcntFile = New CRcntFile
                clsRcntFile.FullName = vaFiles(i)
                Me.Add clsRcntFile
            End If
        End If
    Next i
End Sub

First, I read in the 50 Excel most recently used files. Then I read in the 1,000 most recently used files that I store in a text file, weeding out the duplicates as I go. The advantage of continuing to use the Excel MRU is that I can leverage its pinning feature. I don’t have to write my own pinning bullshit – if you want to pin something, do it via Excel and it will always be in the MRU. Awesome.

Why 1,000 files? I don’t know. We’ll see how the performance holds up. I’ve been using it for three days and my text file is only up to 58 files – the 50 Excel stores plus eight additional. I guess it will take a bit longer to get to 1,000 than I thought, but I think it will be clear when their are too many and I can pare it down.

Next I need a way to write the files back to the text file. When the userform closes, the CRcntFiles.WriteToDisk method is called.

Public Sub WriteToDisk()
    Dim sFile As String
    Dim lFile As Long
    Dim clsRcntFile As CRcntFile
    Dim aFiles(1 To 1000) As String
    Dim lCnt As Long
    lCnt = 0
    For Each clsRcntFile In Me
        lCnt = lCnt + 1
        If lCnt > UBound(aFiles) Then Exit For
        aFiles(lCnt) = clsRcntFile.FullName
    Next clsRcntFile
    sFile = ThisWorkbook.Path & Application.PathSeparator & msMRUFILE
    lFile = FreeFile
    Open sFile For Output As lFile
    Print #lFile, Join(aFiles, vbNewLine)
    Close lFile
End Sub

I lazily write 1,000 lines to the disk even if I don’t have that many. I mean efficiently, not lazily. The text file is 6KB, so I’m not losing sleep over it. I would be pretty trivial to Redim Preserve that after I’ve filled it up, so I supposed I’ll do that after the alpha test.

And other than a few minor tweaks, that’s the only changes I had to make. If that’s not a case for using class modules, I don’t know what is. My userform consumes a CRcntFiles class. It doesn’t care how that class gets filled up or where the list comes from. I could change to storing those recent files in the registry, in an XML file, or tattooed to my back. As long as I can get them into a CRcntFiles instance, the rest of the code is happy.

Save As is jealous of Open. My next problem is that while I can quickly open a recent file, I can’t quickly save a file to a recent place. This is primarily a problem when I open attachments in Outlook. It stores an opened attachment in the Temp folder and when I choose Save As, that’s the folder it starts me in. Nuts to that. If you download this add-in, you’ll also see that I’ve hooked up a SaveAs userform to Ctrl+Shift+S. It’s got a few problems too (it prompts to replace a file twice), but you can try it if you like.

You can download