My Stack Overflow Habit

My Stack Overflow Habit

This is my Stack Overflow profile. There’s lots of numbers: my score, my views, my gold, silver and bronze badges.

My SO profile

The one I’d like to draw your attention to is “1 consecutive.”

Until recently that number was somewhere around 780. Yes, I’d logged into Stack Overflow every single day for well over two years. I’ve offered hundreds of answers and earned quite a few points from people voting for them. Mind you, I’d answer questions even without a scoring system, but it does increase my attraction to the site.

All this time on SO answering, commenting and checking my standings makes me a bit twitchy. So recently I challenged myself to break the streak and go a day without logging in. A day sounded like a long time and I wasn’t sure I could do it.

But I made it through that day, and then a couple more. And although I’ve looked at it briefly over the last two weeks, I’ve pretty much stayed away. Surprisingly, I’ve enjoyed it.

I’ve rediscovered an activity known as “reading novels,” and another excellent pastime which I call “sitting in the back yard drinking a beer.” It also turns out I have a “child” and a “wife.” How great is that?

Don’t get me wrong, I love Stack Overflow. It’s an awesome resource that pops up daily with great answers to my never-ending stream of technical questions. I’m also very proud of my SO contribution to the advancement of Excel and VBA knowledge.

And I live in hope of passing Dick in the all-time Excel_VBA top answerer list.

SO Excel VBA top answerers

But for right now I’m going to do a little thing I like to call “taking a nap.”

Why is Deleting Ranges So Backward?

Why is Deleting Ranges So Backward?

Quite a few questions on Stack Overflow ask about looping through rows and deleting them. The basic question is, “Why is this code only deleting some rows?”:

Set rng = ActiveSheet.Range("A1:A10")
For Each cell In rng
    If cell.value = ""
         cell.EntireRow.Delete
    End If
Next cell

The problem is that the For/Each loop acts like an incrementing For/Next loop, such as:

For i = 1 to 10
    If Activesheet.Cells(i,1) = ""
          Activesheet.Cells(i,1).EntireRow.Delete
    End If
Next i

This means that if it deletes row 2, then row 3 becomes row 2. Meanwhile i increments to 3, so i and the blank cell skip past each other like two contra dancers:

contra dance

The most basic solution – but not the best one – is to loop backwards through the range. Since you can’t do that with a For/Each loop, you’d use a For/Next and alter the incrementing line to:

For i = 10 to 1 Step -1

The reason that’s not a great answer is it’s slow. It’s much faster to identify the entire range to be deleted and then do so in one swell foop. If the criterion for deletion is blanks, for example, you can use SpecialCells, If SpecialCells doesn’t cover it you can build the range with the Union function (that Tim Williams writes some nice code).

Okay, so, that’s useful stuff. The point of this post is less so, but maybe more interesting. My question is:

My Question

Why does a Range collection behave differently than other collections, such as worksheets or workbooks, when deleting items from it?

For example, the code below, which uses an index, deletes every other worksheet because after the first worksheet is deleted the former Worksheets(2) becomes Worksheets(1) and is skipped over by the loop. By now that should be no surprise:

Sub WorksheetLoopIndex()
Dim i As Long

For i = 1 To ActiveWorkbook.Worksheets.Count
    Application.DisplayAlerts = False
    ActiveWorkbook.Worksheets(i).Delete
    Application.DisplayAlerts = True
Next i
End Sub

However, a For/Next loop on worksheets works as you’d want it to, with no skipping. It’s like it figures out in advance which sheets your dealing with and remembers them:

Sub WorksheetLoopForEach()
Dim ws As Excel.Worksheet

For Each ws In ActiveWorkbook.Worksheets
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
Next ws
End Sub

The range collection seems to be the oddball – the only one that processes a For/Each just like a For i = 1 to whatever loop.

Interestingly, if you set a separate range to cells within that same loop it adjusts just fine. For example, consider this code, which does a For/Each through a range of cells, and also assigns the last cell in the range to a separate LastCell range. The For/Next skips past cells as before, but the LastCell range moves up one row with each deletion and shifts from A10 to A9, A8 and so on:

Sub DeleteIndividualCellsForEach()
Dim ws As Excel.Worksheet
Dim rng As Excel.Range
Dim cell As Excel.Range
Dim LastCell As Excel.Range

Set ws = ActiveSheet
Set rng = ws.Range("A1:A10")
Set LastCell = ws.Range("A10")
rng.Formula = "=Row()"
rng.Value = rng.Value
For Each cell In rng
    rng.Interior.ColorIndex = -4142 'none
   cell.Interior.ColorIndex = 6 'red
   LastCell.Interior.ColorIndex = 3 'yellow
   cell.Delete xlUp
Next cell
End Sub

cell looping

So why don’t cells in the For/Next loop behave as nicely?

Copy an xlsm to an xlsx

Copy an xlsm to an xlsx

This post features code I came up with to copy an xlsm to an xlsx. It has a few characteristics:

  • The code lives in the “master” workbook, i.e., the one that’s copied. It’s not in an addin.
  • The copy is an xlsx, stripped of any ribbon menus or VBA,
  • Tables in the master workbook are disconnected from any external data sources.
  • Any pivot tables pointing at tables in the master workbook are now pointing at their newly created copies in the copied workbook.
  • The copied workbook and master workbook are both still open after the code runs.

I looked at a few options when designing this system.

Creating a Workbook Copy
The most attractive choice for saving a copy of a workbook would seem to be the nicely named SaveCopyAs function, which keeps the master workbook open while saving a copy where you specify. Unfortunately, it won’t let you save in another format, so can’t be used to save an xlsm as an xlsx.

The second choice would be the SaveAs function, which does allow you to save in different formats. However, when you do the master workbook closes and the VBA stops running. Not impossible to work around, but I don’t like it.

Probably the best choice, at least in theory, is to run the process from an addin. Such an addin has application-level code to check whether you open any master workbooks. When you do, the ribbon menu is activated, with a button for copying the master. Since all the code is in the addin, the master workbook can be an xlsx and you can use SaveCopyAs. I’ve done a number of projects like this and they lend themselves to better coding practices, such as separating the presentation (pivot tables) from the code and the data. However, my project had just one user and the data sources are all external, so it’s simpler and quite maintainable to give them a workbook with both code and pivot tables. I hope.

So, what I’m actually using is ThisWorkbook.Sheets.Copy, which copies all the sheets. It has a few advantages. Since it’s only copying sheets the only code that gets copied would be in the ThisWorkbook or worksheet modules. I don’t have any so it’s not an issue. (The code would also get deleted when the workbook is saved as an xlsx, but I’m not sure if the user would be prompted about that when they close it). Likewise the ribbon tab, which in included in its own folder in the zip file that constitutes an xlsx or xlsm doesn’t get transferred.

There is one big issue with this method: since we’re copying individual sheets, albeit all of them all at once, any references to other worksheets still point at those worksheets in the master workbook. They don’t automatically transfer over to the new copies. In my case the only references to other sheets are pivot table sources – all other data is external. So I needed a way to point the pivot tables at their respective tables in the new workbook.

Fixing Pivot Table Data Sources

Again the the most appealing method, the pivot table’s ChangeConnection property, won’t work. It’s only for external connections, such as to a SQL Server database or web page. It doesn’t work for pivots connected to tables in the workbook.

My next idea was to modify the SourceData property for each PivotCache in the new workbook. According to Excel 2010 help, this is a read/write property, so it seems pretty straightforward to alter. After several attempts and some web searching I discovered it only works for pivot caches used by only one pivot table. If more than one pivot table points at a cache, PivotCache.SourceData isn’t your friend.

Happily, pivot tables also have a SourceData property. But, of course, there’s a catch here too. if you set two pivot tables’ SourceProperty to the exact same range, two pivot caches will be created. I want as few pivot caches as possible in a workbook, one for each distinct range.

So I came up with code that loops through each pivot table in the new workbook. First it calculates the string for the corrected data source, i.e., the external one with the workbook part stripped away. For example, if we remove the workbook part, e.g., “Master.xlsm”, from “Master.xlsm!tblPivotSource”, we get “tblPivotSource” which we can use to point at the correct table in the copied workbook.

As the code loops through the pivot tables it does one of two things:

  1. It sets the pivot table’s SourceData to the newly calculated NewSourceData variable. It only does this for the first pivot table with that source. Setting the SourceData creates a new pivot cache that uses the same SourceData.
  2. In each loop it first checks if there’s already a pivot cache with that source, which will be true if step 1 has already happened. If that’s the case, I set the pivot’s CacheIndex property to the index of that cache.

(Note that steps 1 and 2 happen in reverse order in the code, it’s just easier to describe them in this order.)

One very nice thing is that if a pivot cache no longer has any pivot tables pointing at it, that cache is automatically deleted.

The end result is that the copied workbook now has the same number of pivot caches as it started out with, each pointing at a table within the copied workbook. As mentioned earlier the listobjecs are also unhooked from their external connections.

Without further ado:

Sub CreateWorkbookCopy()
Dim wbWorkbookCopy As Excel.Workbook
Dim WorkbookCopyName As String
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim pvt As Excel.PivotTable
Dim pvtCache As Excel.PivotCache
Dim NewSourceData As String

Const SUBFOLDER_NAME As String = "Copied_Workbooks"

'Copies all worksheets, but not VBA or Ribbon
ThisWorkbook.Sheets.Copy

Set wbWorkbookCopy = ActiveWorkbook
With wbWorkbookCopy
    For Each ws In .Worksheets
        'Delete all listobject connections
       For Each lo In ws.ListObjects
            lo.Unlink
        Next lo
        'the pivot table caches are still pointing at ThisWorkbook, so
       'point them at wbWorkbookCopy
       For Each pvt In ws.PivotTables
            'note that the "!" is the delimiter between a workbook and table
           NewSourceData = Mid(pvt.SourceData, InStr(pvt.SourceData, "!") + 1)
            'if we just set the SourceData property we get a new cache for each sheet
           For Each pvtCache In wbWorkbookCopy.PivotCaches
                'if a previous loop has already re-pointed a pivot table,
               'then a new PivotCache with that SourceData has been created,
               'so just set the pivot table's cache to that
               If pvtCache.SourceData = NewSourceData Then
                    pvt.CacheIndex = pvtCache.Index
                Else
                    pvt.SourceData = NewSourceData
                End If
            Next pvtCache
        Next pvt
        'apparently PivotCaches are automatically deleted if no pivot tables are pointing at them
   Next ws

    If Not SubFolderExists(ThisWorkbook.Path & Application.PathSeparator & SUBFOLDER_NAME) Then
        MakeSubFolder ThisWorkbook.Path & Application.PathSeparator & SUBFOLDER_NAME
    End If
    WorkbookCopyName = Replace(ThisWorkbook.Name, ".xlsm", "") & "_copy_" & Format(Now(), "yyyy_mm_dd_hh_mm_ss") & ".xlsx"
    .SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & SUBFOLDER_NAME & _
                      Application.PathSeparator & WorkbookCopyName, FileFormat:=51
End With
End Sub

For many useful functions involving pivot caches, please visit this wonderful Contextures page.

Irregular Banding for Repeated Values

Irregular Banding for Repeated Values

A couple of years ago I came up with a formula to apply irregular banding for repeated values in a table or a pivot table. It uses conditional formatting and this SUMPRODUCT formula:

=MOD(SUMPRODUCT(($B$1:$B1<>$B$2:$B2)*1),2)=0

This array-type formula basically says: Count the number of times the value changes from one cell to the next up to the row where I am (assuming for a moment that I’m a cell). Divide that count by two, and check whether the remainder is 0. This True/False result can then be used to apply the conditional formatting.

The formatting looks like this, where the banding is based on changes in the Animal column:

irregular banding 1

If the above looks familiar, you may be thinking of this DDOE chestnut:

DDOE irregular bandingf

The difference, aside from my more subdued color scheme, is that Dick’s only starts a new band for the first hamster or what-have-you. It assumes (I assume) that each animal only has one group. Mine assumes bands of hamsters all over the place, and applies a new stripe with every change.

The bad news is my formula doesn’t do well in a long list if you try to delete large numbers of rows. For example, with 20,000 rows if I try to delete all but one, Excel goes into “Not Responding” mode longer than my patience will tolerate (roughly 35 seconds). I don’t know exactly why, but I bet if I re-read this Charles Williams post I would.

The other problem is, as John Walkenbach mentions in Dick’s post, the banding fails if you insert a line before the first row. I tried solving this by using INDEX (and OFFSET, I think) and learned you can’t use it in conditional formatting. Bummer.

The good news is neither of these problems affects its use in pivot tables.

So what to do if you’ve got a 20,000 rows of data you want to band irregularly? The answer, as Tushar Mehta pointed out, is a helper column:

irregular banding with helper column

Here’s the formula, starting in A2:

=IF(B2=OFFSET(B2,-1,0),OFFSET(A2,-1,0),SUM(OFFSET(A2,-1,0),1))

It uses the volatile OFFSET function. If you’re going to add or delete rows, OFFSET keeps you from getting #REF! errors or having gaps in the logic.

Then your conditional formatting formula is just: =MOD($A2,2)=0

One cool thing about the helper column banding formula above: It utilizes the fact that SUM ignores any text in the range you’re summing. If you get rid of the SUM and change it to =IF(B2=OFFSET(B2,-1,0),OFFSET(A2,-1,0),OFFSET(A2,-1,0)+1), you’ll get #VALUE! errors because of the text in A1.

Oh wow, look at the time. I’ve got to go restripe my parking lot. With these handy formulas it should go quickly though. See you soon!

art

Mod With no Zeroes

Mod With no Zeroes

I use both VBA’s and Excel’s Mod function occasionally, and many times I’ve wanted them to behave a little differently.

As described at its web page, the Mod function:

Returns the remainder after number is divided by divisor.

Mod is useful when you want to cycle through a group assigning repeating values to its members. It’s like when you go to a work training and have to count off by fours so you can break up into small groups and brainstorm or, preferably, when you go to the beach and have to come up with capture-the-flag teams. Here’s how it might look in Excel.

groups of four 1

The thing is that the MOD function won’t give you quite that result, at least not without a little tweaking. Because it returns the remainder, the cycle always starts at one and ends at zero. So at your meeting it’s as if you asked people to count off like:

counting by fours - Abbey Road

The solution is pretty simple (though it took me a while to figure out). Subtract one from the number you’re MODding, MOD it, and add one to the result. For example, in the worksheet above the formula in the Group column is:

=MOD(ROW()-2,4)+1

(We’re subtracting 2 because the names start in row 2)

Here’s a simple procedure in VBA to process that same list, using the same manipulation of MOD:

Sub GroupAttendees()
Dim ws As Excel.Worksheet
Dim i As Long
Dim Attendees As Variant
Dim GroupCount As Long

Set ws = ActiveSheet
Attendees = Application.Transpose(ws.ListObjects(1).ListColumns("Name").DataBodyRange)
GroupCount = 4
For i = LBound(Attendees) To UBound(Attendees)
    Debug.Print Attendees(i); " "; ((i - 1) Mod GroupCount) + 1
Next i
End Sub

Here’s the results in the immediate window:

VBA results

For a thorough discussion of Mod, including some gotchas, this page looks interesting.

Four ListObject QueryTable Tests – Each Better Than the Last

Four ListObject QueryTable Tests – Each Better Than the Last

I started with this devil-may-care bit of code:

Sub Zero()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject

For Each ws In ThisWorkbook.Worksheets
    For Each lo In ws.ListObjects
        On Error Resume Next
        lo.QueryTable.Refresh
        On Error GoTo 0
    Next lo
Next ws
End Sub

Just wrap the QueryTable.Refresh in an On Error pair and don’t sweat it, that was my stance, at least for a day or two. If the ListObject had a QueryTable it would get refreshed. If it didn’t, it wouldn’t.

As the time got closer to hand it off to other people – people who might be bummed if their data didn’t refresh for reasons I hadn’t anticipated – I took a more prudent approach. I wrote some code to check if the ListObject actually had a QueryTable. This allows me to isolate the “ListOject with no QueryTable” error from all the others that might fly in under the radar.

I ended up with a simple function that’s now in my code library. But before we get to that, I’ll show you three lesser ListObject QueryTable tests, from bad to better:

#1 – Testing with Err.Number

In case you’re not familiar with On Error statements, I should clarify that On Error Resume Next let’s your code run willy-nilly through any and all errors. The madness only ends when an On Error Goto 0 statement is encountered. On Error Goto 0 also resets Err.Number to 0.

Sub One()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim qt As Excel.QueryTable

For Each ws In ThisWorkbook.Worksheets
    For Each lo In ws.ListObjects
        On Error Resume Next
        Set qt = lo.QueryTable
        If Err.Number = 0 Then
            qt.Refresh
        End If
        On Error GoTo 0
    Next lo
Next ws
End Sub

I would never do this (not even in a really old Google Groups answer, I hope). It doesn’t fix the basic problem. The refresh is still happening with On Error set to Resume Next. It’s even worse if you have Else clauses. You could blunder through them as well before getting back to On Error Go To 0. The only way I can see it working is with another On Error Go To 0 right inside the IF clause before the refresh, and that’s just ugly.

#2 – Using an ErrorNum variable

Sub Two()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim qt As Excel.QueryTable
Dim ErrorNum As Long

For Each ws In ThisWorkbook.Worksheets
    For Each lo In ws.ListObjects
        On Error Resume Next
        Set qt = lo.QueryTable
        ErrorNum = Err.Number
        On Error GoTo 0
        If ErrorNum = 0 Then
            qt.Refresh
        End If
    Next lo
Next ws
End Sub

This approach fixes the problem in the previous routine by immediately setting an ErrorNum variable to Err.Number’s value. This tightens up the On Error Resume Next scope so it’s only active during the test. Pretty good, and for tests that don’t involve objects I’d probably stop there.

#3 – You’ve got an object variable, just use that!

Sub Three()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim qt As Excel.QueryTable

For Each ws In ThisWorkbook.Worksheets
    For Each lo In ws.ListObjects
        Set qt = Nothing 'Don't forget this!
        On Error Resume Next
        Set qt = lo.QueryTable
        On Error GoTo 0
        If Not qt Is Nothing Then
            qt.Refresh
        End If
    Next lo
Next ws
End Sub

Since we’re trying to set qt to something, let’s just test if it’s not nothing. This has the same advantage as the previous one: On Error statements bracket just the one line of your test, preventing stealth errors. The big gotcha is you’ve got to remember to set qt to Nothing before you try to set it to something. Otherwise, if the previous ListObject had a QueryTable, and this one doesn’t, the Resume Next will happily ignore the error and leave qt set to the previous one. That’s confusing, and potentially tragic.

#4 – The right way

Sub Four()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim qt As Excel.QueryTable

For Each ws In ThisWorkbook.Worksheets
    For Each lo In ws.ListObjects
        Set qt = GetListObjectQueryTable(lo)
        If Not qt Is Nothing Then
            qt.Refresh
        End If
    Next lo
Next ws
End Sub

Function GetListObjectQueryTable(lo As Excel.ListObject) As Excel.QueryTable
On Error Resume Next
Set GetListObjectQueryTable = lo.QueryTable
End Function

Here I’ve moved the test into a function and put it in my utility module along with tests for workbook state, folder existence and other such mundanities. I know it works, I don’t have On Errors in the main module, and I only need Resume Next in the function, cause there’s not a heckuva lot of room for resuming.

Tangential miscellany

Here’s a pithy Jeff Weir rant on testing for ActiveCell.PivotTable versus ActiveCell.Listobject

This post deals with Excel-2007-and-on ListObject.QueryTables. In earlier versions QueryTables belonged to the worksheet they were on. In this Stack Overflow answer Dick (DDOE) Kusleika posts a function to find any QueryTable by name.

A thing I should know, but maybe you can tell me

What’s the difference between ListObject.Refresh and QueryTable.Refresh?

Pivot Table Circular References

Pivot Table Circular References

The other day I ran into a workbook containing a circular reference between a pivot table and a regular table. The table based calculations on the pivot table, which were then used in a summarizing calculated field in the pivot table, or something like that. This seemed like a dicey approach, so those fields and formulas are with us no more. But it did get me wondering about pivot table circular references.

Content Advisory: This post contains material that will be useless to most, if not all, viewers. On the other hand, it’s mostly pictures.

Below is one of those interactive embedded workbooks I love so well. It has a dead simple example of a circular reference involving a pivot table and a table. The pivot table is based on the data cell, which in turn has a formula to multiply the pivot cell times two. Right-click somewhere in the pivot and hit “refresh” to see it in action.

Then I wondered if you can take it one step further and base a pivot table on itself. Turns out you can:

Create self referencing pivot 1

Create self referencing pivot 2

Create self referencing pivot 3

Create self referencing pivot 4

So there it sits, a self-referencing pivot table. Sit is about all it does though. You can’t change it:

alt=

And if you Refresh it, it disappears, because the original source column name has been overwritten. For example, the “Data” field above became “Sum of Data.”

I fooled around with calculated fields, but Excel doesn’t let you chain those back to themselves. And now I understand of why you can’t give a pivot table’s Value field the same name as its underlying data field. (For example if you remove the “Sum Of ” part Excel squawks at you.) If you could, I think you could make a calculated field that doubled itself.

If anybody comes up with a more interesting example or use of pivot table circular references, please share.

SheetActivate Event Doesn’t Fire Between Multiple Windows

SheetActivate Event Doesn’t Fire Between Multiple Windows

In VBA you use the SheetActivate event to track when a user switches from one sheet to another. Sometimes I use it to control the state of menu items that I only want available when certain sheets are active. In the workbook below, I only want the “Add Color” button enabled when the “Colors” sheet is active.

Add Color button

The SheetActivate event works fine for this, most of the time, using code similar to this:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'forces the button's getEnabled code (below) to run
g_Ribbon_Invalidate
End Sub

Public Sub cmdAddColor_getEnabled(control As IRibbonControl, ByRef returnedVal)
'the button is enabled only if "Colors" is the active sheet
returnedVal = ActiveSheet Is ThisWorkbook.Worksheets("Colors")
End Sub

Below, the Add Color button has been disabled after switching to another sheet, just like I want:

Add Color button disabled

Recently I noticed this doesn’t necessarily work if the workbook has two or more windows. In that case, switching from one window to another doesn’t trigger the SheetActivate event, even if the second window has a different active sheet than the first. Below, I’ve switched from the “Colors” sheet in one window to the “No Colors Allowed!” sheet in the second window. The SheetActivate event hasn’t fired and the button is still enabled. It’s out of sync.

Add ButtonWindow Error

I guess it makes sense that SheetActivate wouldn’t fire. After all, within each window the active sheet is still the same. (Happily, the ActiveSheet property is still updated.)

In order to keep the button in sync, add a WindowActivate event to your code. Between it and the SheetActivate code, you’ll handle moves between sheets within the same window, and between windows to a different sheet:

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
g_Ribbon_Invalidate
End Sub

Download!
You can check it out in this sample workbook.

Escape Accidental File Moves

Escape Accidental File Moves

Every so often I’m merrily dragging folders or files around when I realize I’m making a painful blunder. For whatever reason, in mid-drag I just want out. Sure, I could try to retrace my steps back to the source, but maybe it’s no longer in sight. Of course, I could do a Ctrl-Z after the fact and hope that Undo does. But really I just want to escape the accidental file move right now:

Esc key

So one day I did just that. I hit the Escape key and trouble was averted.

I know the real solution is to never drag and always cut/copy and paste with Ctrl shortcuts or menus. But since that’s not going to happen, at least I’ve got an escape plan.

This works in Outlook, the VBA IDE and other places as well.

Listing UserForm Accelerator Keys

Listing UserForm Accelerator Keys

Towards the end of the last post I showed a form I made to copy query properties from one table to another. That userform has 20 controls and, as always before I post something for your enjoyment, I tried to make is as user-friendly as possible.

So I set the default and cancel properties to the appropriate buttons and arrange the tab order of all the controls. When that’s done I assign accelerator keys to some of the controls. The accelerator property specifies a letter or other key, which when pressed along with the Alt key, activates that control.

button accelerator key

In the example above, a helpful but peevish developer has specified the % key as the accelerator, perhaps for the first time in history.

tab_ dialog

I enjoy the fiddly work of setting tab orders and accelerators. I’d enjoy it more if the tab order dialog weren’t so hard to read.

It’s also hard to tell which controls have which accelerators and whether you’ve already used a certain letter.

So I wrote a bit of code that takes a userform as an argument and prints the relevant control properties to a newly-minted worksheet.

Sub ListUserFormAccelerators(frm As UserForm)
Dim ControlsCount As Long
Dim i As Long
Dim ctl As msforms.Control
Dim ControlName As String
Dim ControlTabIndex As Long
Dim ControlCaption As String
Dim ControlAccelator As String
Dim ControlProperties() As Variant
Dim ws As Excel.Worksheet
Const TableHeaders As String = "TabIndex,Name,Caption,Accerator,Count"

ControlsCount = frm.Controls.Count
ReDim ControlProperties(1 To ControlsCount, 1 To 4)
For i = 1 To ControlsCount
    Set ctl = frm.Controls(i - 1)
    ControlName = ctl.Name
    ControlTabIndex = ctl.TabIndex
    ControlCaption = ""
    ControlAccelator = ""
    'some controls don't have the next two properties
   On Error Resume Next
    ControlCaption = ctl.Caption
    ControlAccelator = ctl.Accelerator
    On Error GoTo 0
    ControlProperties(i, 1) = ControlTabIndex
    ControlProperties(i, 2) = ControlName
    ControlProperties(i, 3) = ControlCaption
    ControlProperties(i, 4) = ControlAccelator
Next i
Set ws = Workbooks.Add.Worksheets(1)
With ws
    .Range("A1:E1") = Split(TableHeaders, ",")
    .Range("A2").Resize(ControlsCount, 4) = ControlProperties
    With .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes)
        .Name = "tblControlProperties"
        .ListColumns("Count").DataBodyRange.FormulaR1C1 = "=COUNTIF([Accerator],[@Accerator])"
        With .Sort
            .SortFields.Add Key:=Range("tblControlProperties[TabIndex]")
            .Header = xlYes
            .Apply
        End With
        .Range.Columns.AutoFit
    End With
    'Want to close without prompt to save
   .Parent.Saved = True
End With
End Sub

The code loops through a form’s controls and ultimately adds them all to an array which is dumped into a worksheet created in the code.

You’d call it like this:

Sub HereYouGo()
ListUserFormAccelerators frmCopyTableQuery
End Sub

And the result looks like this (click on it to open in its own, larger, window):

code output

You may notice that some of the accelerators are doubled above. Each pair is for a label, followed by a textbox with no accelerator and then by a checkbox, which has the second occurrence of that acceelator. There’s two things going on here. The first is that if a control isn’t a Tab Stop, like a label, then the accelerator will take you to the next control, in this case the textbox. The second is that I wanted the user to be taken to the associated checkbox if they hit the accelerator again.

I can’t figure out how to call this code from another project. I messed around with Application.VBE.VBProjects, but can’t get it to work. Another nice thing would be the inverse of this code, a routine that would apply the tab order and accelerators from the worksheet to the userform.