Author Archive

Creating Tables the Right Way

And by ‘right way’ I mean the way I want. JKP commented:

I wish MSFT would put a tablename box right into the “Format as Table” dialog as it is the first thing I do after formatting a range as a table. O, and always put that checkbox on. My tables always have a header row.

I couldn’t agree more. So why not repurpose Ctrl+T to do what I want.

Sub MakeTable()
    Dim sh As Worksheet
    Dim sName As String
    Dim lo As ListObject, loExists As ListObject
    Const sSHEETSTART As String = "Sheet"
    Const sTABLESTART As String = "tbl"
    Set sh = ActiveSheet
    'Get the name of the table from the user
    sName = Application.InputBox("Enter the table name", "Table Name")
    'If the user didn't click Cancel
    If sName <> "False" Then
        'Start the table with 'tbl' if it doesn't already
        If Left$(sName, Len(sTABLESTART)) <> sTABLESTART Then
            sName = sTABLESTART & sName
        End If
        'Create the table and name it
        Set lo = sh.ListObjects.Add(xlSrcRange, ActiveCell.CurrentRegion, , xlYes)
        'See if that name exists on this sheet
        On Error Resume Next
            Set loExists = sh.ListObjects(sName)
        On Error GoTo 0
        'If the name doesn't exist
        If loExists Is Nothing Then
            lo.Name = sName
            'If the sheet isn't already specifically named, name it
            If Left$(sh.Name, Len(sSHEETSTART)) = sSHEETSTART Then
                On Error Resume Next
                sh.Name = Replace$(lo.DisplayName, "tbl", vbNullString)
            End If
        End If
    End If

End Sub

This code makes a lot of assumptions about how I work with tables, so it may not work for you. First, I ask for the table name. I start all my table names with tbl, so if I don’t include that the code includes it for me. Next, I create a new ListObject based on the CurrentRegion of the ActiveCell. This is different than what Excel does. If you only have one cell selected, Excel will use the CurrentRegion. If you have more than one cell selected, Excel assumes you’ve defined the range you want and uses that. I put one table on one sheet and it’s the only thing on there. Therefore, I always want everything on that sheet to be the table.

Next, I see if a table with that name already exists on the sheet. If it does, skip the whole naming part.

Finally, I change the name of the sheet if it’s still named the generic ‘Sheetx’. I drop the ‘tbl’ part from the DisplayName property and name the sheet. The error avoidance is in case there’s already a sheet with that name. In that case, the name remains unchanged.

Why the DisplayName? If you name a table tblList, you can’t name another table tblList on the same sheet. In fact, in the user interface you can’t name another table tblList in the whole workbook. But in code, you can name another table tblList as long as it’s on a different sheet. If that name already exists, ListObject.Name remains tblList, but ListObject.DisplayName is changed to tblList_1. That’s why I check for the existence of that table on the same sheet but not the whole workbook. And that’s why I use the DisplayName to name the sheet.

I should have skipped all this error checking and just put a big On Error Resume Next at the top. I probably will never have two tables with the same name, and if I accidentally did, it would just keep the default name.

Converting an Excel Range to HTML the Hard Way

Every time I write a RangeToHTML function, it’s different. I don’t re-use my old functions because the HTML elements that I care about change from project to project. I could make a generic RangeToHTML function that attempts to capture every possible cell property, but I don’t. I don’t want a bunch of code in my project that doesn’t do anything. I figure out which cell properties matter to the project and code those.

In this example, I not only did not want fidelity with the spreadsheet, I was using bold and italics to trigger completely different HTML elements. But usually I’m trying to make the cells look like they do in the spreadsheet for those characteristics that I’ve deemed important. Below is another example where I’m converting a range to HTML to put into an Outlook email. The things that are important to me are bold, italics, font size, cell alignment, merged cells, and bottom borders. That’s a lot of stuff, but it’s not every formatting element that could be applied to a cell.

Public Function RangeToHTML(ByRef rRng As Range) As String
    Dim rRow As Range, rCell As Range
    Dim sTable As String, sTd As String, sHead As String
    Dim aCells() As String, aRows() As String, aAttr() As String, aHead(1 To 2) As String
    Dim lCellCnt As Long, lRowCnt As Long
    Dim lFontSize As Long
    '1. Get the font size of the last cell
    lFontSize = rRng.Cells(rRng.Cells.Count).Font.Size
    ReDim aRows(1 To rRng.Rows.Count)
    '2 create the style in the header
    aHead(1) = "td {font-family:" & rRng.Cells(1).Font.Name & "; font-size: " & lFontSize & "pt}"
    aHead(2) = ".bb {border-bottom: 1px solid black}"
    sHead = Tag(Tag(Join(aHead, vbNewLine), "style", , True), "head", , True)
    '3. Load up a 'cells' array and a 'rows' array FOR joining.
    For Each rRow In rRng.Rows
        lRowCnt = lRowCnt + 1: lCellCnt = 0
        ReDim aCells(1 To rRng.Columns.Count)
        For Each rCell In rRow.Cells
            lCellCnt = lCellCnt + 1
            '4. Deal with empty cells and multi-line cells
            If IsEmpty(rCell.Value) Then
                sTd = "&nbsp;"
                sTd = Replace(rCell.Text, Chr$(10), "<br />")
            End If
            '5. Bold and italic
            If rCell.Font.Bold Then sTd = Tag(sTd, "strong")
            If rCell.Font.Italic Then sTd = Tag(sTd, "em")
            '6. Font size
            If rCell.Font.Size <> lFontSize Then
                sTd = Tag(sTd, "div", "style=font-size:" & rCell.Font.Size & "pt")
            End If
            '7. Setting the cell alignment
            ReDim aAttr(1 To 3)
            aAttr(1) = AlignmentAttr(rCell)
            '8. Span rows and columns for merged  cells
            If rCell.MergeArea.Address <> rCell.Address Then
                aAttr(2) = "COLSPAN=""" & rCell.MergeArea.Columns.Count & """ ROWSPAN=""" & rCell.MergeArea.Rows.Count & """"
            End If
            '9. Bottom border
            If rCell.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone Then
                aAttr(3) = "class=""bb"""
            End If
            '10. Make string
            If rCell.MergeArea.Cells(1).Address = rCell.Address Then
                aCells(lCellCnt) = Tag(sTd, "td", Join(aAttr, Space(1)))
            End If
        Next rCell
        aRows(lRowCnt) = Tag(Join(aCells, vbNewLine), "tr", , True)
    Next rRow
    sTable = Tag(Join(aRows, vbNewLine), "table", "cellpadding=""2px""", True)
    RangeToHTML = Tag(sHead & vbNewLine & sTable, "html", , True)
End Function

Here’s a breakdown of code:

  1. It’s a bit arbitrary, but I’m pulling the font size from the last cell in the range. For my data, I know that the header may have a different font size, but there is no footer. Whatever the last cell in the range is, that’s my default font size.
  2. I create two styles in the header: one for the default td element and one for the “bb” class (bottom border). The font name is pulled from the first cell of the range (because I know there’s o change in font family within the range. The font size I get from above. My Tag function is nested here so that my styles are in a ‘style’ tag and then the whole thing is wrapped in a ‘head’ tag.
  3. Inside the loop, I fill the aCells array with each cell. Before I go to the next row, I Join that array into an element of the aRows array. Later I’ll be Joining that array into a big string.
  4. If the cell is empty, I need a non-breaking space in my td tags. If the cell has more than one line, I insert the br HTML tag to replicate that.
  5. At this point, I’m just checking out the cell properties and converting them to HTML. These two lines wrap the value in ‘strong’ or ‘em’ if the cell is bold or italic, respectively.
  6. I got the default font size up in step 1. If this cells font size is different than the default, then I set it explicitly. I’d considered trying to make everything a relative font size, but ultimately it was a pain and unnecessary.
  7. There are three cell properties that will turn into attributes in the td tag. The first is the cell alignment. I have left, right, and center cells and set the align property using the AlignmentAttr function shown below.
  8. Next, I look for merged cells and set the COLSPAN and ROWSPAN attributes accordingly. Yes, I hate merged cells too, but sometimes they’re necessary.
  9. The I look for a bottom border, which I implement in a css class. I don’t look for every border because I only care about bottom borders.
  10. Finally, I make the string by Joining my Attr array. If I’m in the first cell of a merged area (which also is true if there is no merge area), then I make the string. If I’m not in the first cell, I don’t do anything because I’ve already done it back when I was in the first cell.

To wrap it all I up, I tag and join everything into one glorious string. The Tag function looks like this:

Function Tag(sValue As String, sTag As String, Optional sAttr As String = "", Optional bIndent As Boolean = False) As String
    Dim sReturn As String
    If Len(sAttr) > 0 Then
        sAttr = Space(1) & sAttr
    End If
    If bIndent Then
        sValue = vbTab & Replace(sValue, vbNewLine, vbNewLine & vbTab)
        sReturn = "<" & sTag & sAttr & ">" & vbNewLine & sValue & vbNewLine & "</" & sTag & ">"
        sReturn = "<" & sTag & sAttr & ">" & sValue & "</" & sTag & ">"
    End If
    Tag = sReturn
End Function

The AlignmentAttr function from #7 above. I put this in its own function to keep the close a little cleaner, not because it does anything special.

Public Function AlignmentAttr(ByRef rCell As Range) As String
    Dim sReturn As String
    Select Case True
        Case rCell.HorizontalAlignment = xlLeft, (rCell.HorizontalAlignment = 1 And Not IsNumeric(rCell.Value))
            sReturn = "align=""left"""
        Case rCell.HorizontalAlignment = xlRight, (rCell.HorizontalAlignment = 1 And IsNumeric(rCell.Value))
            sReturn = "align=""right"""
        Case rCell.HorizontalAlignment = xlCenter
            sReturn = "align=""center"""
    End Select
    AlignmentAttr = sReturn
End Function

Weeding the KwikOpen Garden

A little less than a year ago, I said

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 there are too many and I can pare it down.

I hit 1,000 files a few days ago. Performance? Not even an issue. I upped it to 2000 and have been humming along nicely. The only downside is when I’m not on my machine and have to navigate the File Open dialog like an animal.

I know there are some files in my MRU that no longer exist. I didn’t try to delete them, I just let them stay in the list until I tried to open one and it said it didn’t exist. At the point, the code would allow me to navigate to its new location. I wanted to see how many files were no longer there.

Public Sub FindMissing()
    Dim clsRcntFiles As CRcntFiles
    Dim clsRcntFile As CRcntFile
    Dim lCnt As Long
    Set clsRcntFiles = New CRcntFiles
    For Each clsRcntFile In clsRcntFiles
        If Len(Dir(clsRcntFile.FullName)) = 0 Then
            Debug.Print clsRcntFile.FullName
            lCnt = lCnt + 1
        End If
    Next clsRcntFile
    Debug.Print lCnt
End Sub

This told me that it couldn’t find 234 files. That’s a lot. I really need a way to weed those files out of my MRU.

When I first wrote this code, I checked to see if the file existed before I added it to the listbox on the userform. If the file didn’t exist at that location, it didn’t get added to the listbox. If it didn’t get added to the listbox, it didn’t get written back out to the MRU. This culled the list nicely, but presented a problem pretty early on. A couple of days into using my new creation, I typed in a file name that I new I had recently opened. I didn’t remember that I moved that file to a different file. Of course, I go no results when I typed in the name even though I was certain I should have.

Once I realized why, I decided that having files disappear was not good for my psyche. It would be better to show the file, select it, then get a message that it didn’t exist. I removed the code that checked whether the file exists and didn’t implement anything that would remove files from the list short of clicking on them. Basically, I pushed that problem into the future. Well, the future is now. With 20% of my MRUs missing, I suppose it’s time to take a smarter tack.

I’m faced with a design decision. I need missing files to hang around for at least some amount of time, but not forever. Here are some choices I’ve been considering:

  1. Time stamps: I could time stamp each entry with the “last open date”. Entries less than one month old are never deleted. Missing entries older than one month get deleted automatically. The dissonance I experienced searching for a missing file that I was sure wasn’t missing occurred because I had had that file open within the last few days. I don’t think I would have the same experience with a file that I’d opened last month. Instead, I would assume I was misremembering as opposed to being crazy. I like the fact that this happens automatically – with no user intervention. I don’t like the fact that I have to store the date. My file goes from a clean, simple list to a data structure.
  2. Marking missing files: I could put an asterisk in front of files in the listbox that were missing. That way I would know what was missing and could click on them to clean them up, even if I didn’t intend to open them at that time. As I type this option, I hate it even more. Distracting myself with pointless housekeeping while I’m trying to get something done is a terrible idea.
  3. Cleanup utility: I could make a separate utility that the user could periodically run. It would list the missing files and allow the user to “find” any of them that he thinks is important and remove the rest. I wouldn’t have to touch any existing code or data for this, which is a positive. It’s not automatic like the #1, which is a negative.

I’ll probably go with #1, but I haven’t decided yet.

Switching Aggregates in Pivot Fields

We’ve all been there. You create a pivot table, add your Values fields, and Excel thinks you want to Count them instead of Sum them just because you have a few blanks.

To fix it, you can click the yellow Count of Labor (for example), choose Value Field Settings, and change the aggregate. Or you can right click on any field and choose Summarize Values By and switch it to Sum. Both good options, but not good enough. I assigned Ctrl+Shft+A to this happy little customer and I’m toggling aggregates like crazy.

Sub SwitchAggregate()
    Dim pf As PivotField
    'Make sure the activecell is in a pivot field
    On Error Resume Next
        Set pf = ActiveCell.PivotField
    On Error GoTo 0
    If Not pf Is Nothing Then
        'Toggle between sum and count
        If pf.Function = xlSum Then
            pf.Function = xlCount
            pf.Function = xlSum
        End If
    End If
End Sub

There’s probably a bug or two, but so far so good.

Handling Errors when Opening Outlook Attachments

Back in 2013 when I returned to using Outlook as an email client (new job, prior job used Google Apps), I was sprucing up some old code. I have two problems with the code on that page; one I’m solving here and one I don’t know how to solve yet.

The first problem is when someone sends me two attachments. I want to open the first, but have no interest in the second. Most recently this problem manifests itself as an invoice and a packing list. I need the invoice, but I don’t need the packing list. Alt+3 (this macro is third on my QAT) opens the last attachment first, so I’m stuck opening the packing list, closing it, then opening the invoice. In practice, I open it the old fashioned way (Shft+Tab, Home, Ctrl+Shft+RightArrow, Menu, O). Go ahead and try it. You know you want to. The Menu key is the key between Alt and Ctrl on the right side of my keyboard. Even if I concentrate really hard on the first attachment, the code still opens them just like a programmed. I don’t have a solution for this.

The second problem is when someone sends me an attachment with no file extension or some bullshit file extension. I get a text file with a .success extension from a website telling me my upload worked. I’m not sure if they’re just being clever or if there is some other significance, but I do know that Windows, and more specifically WScript.Shell, doesn’t know how to open it. I had some code that checked for no extension and opened it in Notepad++, but recently changed it to handle any unknown file extension.

Public Sub DisplayAttachment(olAtt As Attachment, sFile As String, sPath As String)
    Dim oShell As Object
    Dim miNew As MailItem
    On Error GoTo ErrHandler
    If olAtt.Type = olEmbeddeditem Then
        Set miNew = Application.GetNamespace("MAPI").OpenSharedItem(sPath & sFile)
        sFile = GetShortFileName(sPath & sFile)
        Set oShell = CreateObject("WScript.Shell")
        oShell.Run sFile
    End If

    Exit Sub
    Select Case Err.Number
        Case -2147023741
            oShell.Run "C:\PROGRA~1\NOTEPA~1\NOTEPA~1.EXE" & Space(1) & sFile
        Case Else
            MsgBox Err.Number & vbNewLine & Err.Description
    End Select
    Resume ErrExit
End Sub

Good ol’ error handling. If WScript.Shell can’t open the file, it throws error -2147023741, better known as Automation error. No application is associated with the specified file for this operation. When that happens, it opens the file in Notepad++. That may not always be the best choice, but usually is. Happy keyboarding.


Fellow keyboarder, Peter, said I should try KeyRocket.

KeyRocket is an application that teaches shortcuts.

Sounds right up my alley, so I download the evaluation version. It doesn’t say, or I couldn’t find, how long the evaluation lasts. I have a couple of thoughts about the install process. First, I like that when you click the Download button, you not only go to the download instructions, but the file downloads automatically instead of having to click another link. I can see how some people might not like that, but I do. Second, when the installation is complete you get this:

That’s a great message. You don’t have to do anything except read these five instructions or skip them. What I didn’t like about it? The buttons don’t have accelerators so you have to use the mouse to click Next or Skip. Deliciously ironic.

I “used” it for half a day and didn’t notice it was there. I simply don’t use my mouse, particularly in Excel, so there was nothing for KeyRocket to show me. It’s not KeyRocket’s fault; I’m just not the target customer.

The programs that KeyRocket supports are:

  • Windows – I don’t use the mouse much in Windows
  • Excel – Apparently I never use the mouse in Excel
  • Outlook – I don’t use the mouse here either. I’ve already created shortcuts for the things I do in here.
  • Powerpoint – Please. If I had to use PPT in my job, I would weep a thousand tears.
  • Word – I’ve used Word in my day job probably a dozen times in two years. That’s enough.
  • Visual Studio – I program in VBA, so no dice here.

For those programs I use often, I’ve learned the shortcuts or developed by own. The other programs that it supports, I just don’t use.

There are a couple dozen Shortcuts exclusive to KeyRocket, i.e. not built-in to Excel, but created by KeyRocket. Some of those overwrite my existing special shortcuts, so would have to re-assign those if I were sticking with it.

When I used one of the KeyRocket shortcuts, it showed a little box in the bottom right corner that said “First use of a KeyRocket Shortcut” or something like that. It was very unobtrusive. I’m really impressed with the design decisions these guys made.

After a couple days I was having problems with the VBE. I was getting Out of Memory errors and orphaned instances of Excel and the VBE wouldn’t close. I don’t have any evidence that KeyRocket was causing this, but I had to uninstall it along with a couple add-ins because I couldn’t afford to have the errors. I would have been nice to remove those one-by-one to see which was causing and it would be nice to have all the time in the world and $1 million. I don’t have any of those.

Finally, the premium version is $135 per year. It appears they have a premium version and an enterprise version, but I couldn’t tell was what the premium version was premium in relation to. Is there a standard version? Not that I could find. If premium is the base version, then $135 seems steep. Actually $135 one time would seem steep. Are they supposing that after a year you’ve learned all the shortcuts and you don’t renew? Are they supposing that big, faceless companies pay gobs for software and aren’t that price sensitive? Maybe both.

I’m unequivocally in favor of anything that teaches people keyboard shortcuts. On top of that, I was impressed by the design of this product at every turn. If you want to learn some keyboard shortcuts and your boss doesn’t mind parting with $135, give it a try. If you do try it, even for just the trial period, leave a comment with your impressions.

Joining Two Dimensional Arrays

The Join function takes an array and smushes it together into a String. I love the Join function. The only thing I don’t like about it is when I forget that it doesn’t work on 2d arrays. Join only works with 1-dimensional arrays. The last time my memory failed me, I decided to write my own. And here it is.

Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String
    Dim i As Long, j As Long
    Dim aReturn() As String
    Dim aLine() As String
    ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1))
    ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2))
    For i = LBound(vArray, 1) To UBound(vArray, 1)
        For j = LBound(vArray, 2) To UBound(vArray, 2)
            'Put the current line into a 1d array
            aLine(j) = vArray(i, j)
        Next j
        'Join the current line into a 1d array
        aReturn(i) = Join(aLine, sWordDelim)
    Next i
    Join2D = Join(aReturn, sLineDelim)
End Function

It’s pretty simple. It loops through the first dimension (the row dimension) and joins each line with sLineDelim. Inside that loop, it joins each element in the second dimension with sWordDelim. What this function doesn’t do is automatically insert itself into only the projects I want. That requires me to remember that I wrote it and where I put it. In reality, I’ll probably reinvent the wheel the next time I need it.

Here’s my extensive testing procedure.

Sub TEST_Join2d()
    Dim a(1 To 2, 1 To 2) As String
    a(1, 1) = "The"
    a(1, 2) = "Quick"
    a(2, 1) = "Brown"
    a(2, 2) = "Fox"
    Debug.Print Join2D(a)
    Debug.Print Join2D(a, ",")
    Debug.Print Join2D(a, , "|")
    Debug.Print Join2D(a, ";", "||")
End Sub

Super Bowl Analysis

Every so often my worlds collide like when a football game is so popular that non-football fans are aware of it. This week a bunch of nerds will use Excel to analyze the game and I don’t want to be left out. I’ve isolated what I believe to be the most important factor and data-analyzed the hell out of it.

I think we can all appreciate that the 3D effects really drive the point home. And did you notice the use of color? I know. I’m a genius.

My favorite talking head quote about Super XLIX:

For many people in my family, the advertising shown during the Super Bowl provides as much or more entertainment than the game itself.

You mean a bunch of people only care about the ads? What an insightful thought – had you had it in 1975.