UserForm Event Class – Validating Controls

UserForm Event Class – Validating Controls

At the end of my last post I said I’d be back with an actual use for a multiple-control event class. And here I am! It seems to me that validating controls in a userform is a very good use for this type of class. Not having the validation mixed in could really unclutter the main form and clarify things. So let’s look at a real-life application that I’ve just updated to this kind of control validation. It’s probably full of bugs, but what the heck.

The application is an addin for splitting worksheets into separate workbooks based on one or two columns. The process starts with a form where users choose the row with the headers and the column(s) to split on. The userform opens with the active row selected and the OK button disabled. When users select a primary column the OK button is activated. If they clear the row textbox, pick a secondary column without a primary column, or pick the same column for both, the OK button is disabled and an error message shows. This functionality is all handled in a multiple-control WithEvents class:

three validation messages

As you can see, there’s a textbox at the bottom to display the validation error message. In all three cases, in addition to showing the message, the OK button is disabled. My hope is that this provides a user-friendly experience: guiding them and letting them try different things without wasting their time pushing “OK” when it’s really not.

The class with the validation looks a lot like the multiple-control class from the last post. Just like there, every control’s click or change event calls the same procedure. In this case it’s a validation procedure, called “CheckReadyState.” It runs a few tests to make sure the various controls are in harmony. If so, the form’s “OK” button is enabled. If not, it’s disabled and a validation error message is shown. Here’s the whole class:

Private WithEvents txt As MSForms.TextBox
Private WithEvents lst As MSForms.ListBox
Private WithEvents chk As MSForms.CheckBox
Private WithEvents spn As MSForms.SpinButton
Private m_PassedControl As MSForms.Control
Private m_ParentForm As MSForms.UserForm

Property Set ctl(PassedControl As MSForms.Control)
Set m_PassedControl = PassedControl
Select Case True
Case TypeOf PassedControl Is MSForms.TextBox
    Set txt = PassedControl
Case TypeOf PassedControl Is MSForms.ListBox
    Set lst = PassedControl
Case TypeOf PassedControl Is MSForms.CheckBox
    Set chk = PassedControl
Case TypeOf PassedControl Is MSForms.SpinButton
    Set spn = PassedControl
End Select

Set m_ParentForm = GetParentForm(PassedControl)
End Property

Private Sub chk_Click()
CheckReadyState
End Sub

Private Sub lst_Change()
CheckReadyState
End Sub

Private Sub spn_Change()
CheckReadyState
End Sub

Private Sub txt_Change()
CheckReadyState
End Sub

Private Sub CheckReadyState()
Dim HelpMessage As String
Dim ReadyState As Boolean

ReadyState = True
With m_ParentForm
    If .txtHeaderRowNum = "" Then
        HelpMessage = "Pick a Header Row"
        ReadyState = False
    ElseIf .lstChooser2.ListIndex <> -1 And .lstChooser1.ListIndex = -1 Then
        HelpMessage = "No Primary Column Picked"
        ReadyState = False
    ElseIf (.lstChooser1.ListIndex = .lstChooser2.ListIndex) And .lstChooser1.ListIndex >= 0 Then
        HelpMessage = "Duplicate Columns"
        ReadyState = False
    Else
        'If we got this far then there's no validation errors,
        'so if they've selected at least a primary column we're ready for the OK button
        ReadyState = .lstChooser1.ListIndex <> -1
    End If
    .cmdOk.Enabled = ReadyState
    SetHelpMessage HelpMessage
End With
End Sub

Function GetParentForm(ctl As MSForms.Control) As MSForms.UserForm
Dim ParentForm As Object

Set ParentForm = ctl.Parent
Do Until TypeOf ParentForm Is MSForms.UserForm And Not TypeOf ParentForm Is MSForms.Frame
    Set ParentForm = ParentForm.Parent
Loop
Set GetParentForm = ParentForm
End Function

Sub SetHelpMessage(HelpMessage As String)
m_ParentForm.lblError.Caption = HelpMessage
End Sub

The basic philosophy here is that a change to any control on the form, or, more accurately, any control having a WithEvents type in the public declarations of this class, triggers the validation routine. It doesn’t matter which control triggers it, the same things are validated. That distinguishes this class’s function, I hope, from the type of checking that syncs the spinbutton/textbox combo, for example what to do if the user tries to spin below zero. It also distinguishes the class functions from what happens when the OK button is clicked. Both those are handled within the userform itself.

Of course, the class does refer to individual controls on the userform as part of the validation, such as checking whether the same column was selected for both listboxes. Note that you can refer to the controls with something like “ParentForm.lstChooser1″ although there’s no IntelliSense for them.

I also messed around with a different way to refer to the parent form within the class. As Ross commented on an older post, passing the form to the class seems kind of clunky. I came up with a new clunky way in the “GetParentForm” function. It starts with the calling control and recursively checks parent controls until it climbs to the userform level. As mentioned in my last post, frames are seen as both frame and userform controls when using TypeOf, hence the double check in the “Do Until” line. I could have just checked the control’s TypeName, as mentioned in the last post, but with a form TypeName doesn’t return “UserForm.” It returns “frmWorksheetSplitter” or whatever you called it.

This is all kind of experimental on my part, and I’m sure parts of it could be made more object-oriented or otherwise improved, so let me know. I do like having the validation off in it’s own world, instead of mixing it in with the rest of the form code.

UserForm in action

The userform is similar to the one in A Flexible VBA Chooser Form. To see how it works, and how I populate the listboxes, and any number of wondrous things, download the workbook.

UserForm Event Class – Multiple Control Types

UserForm Event Class – Multiple Control Types

I’ve been fooling around with UserForms lately and have a couple of posts in mind. This one describes a UserForm event class that handles more than one type of form control.

There’s good explanations on the web for creating arrays of userform controls that handle all the events for a certain type of control, like a TextBox. That way, for example, you don’t have to duplicate the click event for each TextBox. In this post I create a single event-handler class for multiple types of controls: CheckBoxes, ComboBoxes, OptionButtons, and the like. This way you don’t need to create a separate class for each type of control – one class can handle them all.

(If the idea of an array of event-handler classes is new to you, please click the link above. John Walkenbach has a nice example too. The very brief explanation is that you create an array of classes, one for each control, which then handle whatever control events you specify in the class. Note that I use a collection instead of an array. That’s just how I learned it.)

The class in this example, called “clsMultipleControls,” handles the click or change events for CheckBoxes, ComboBoxes, ListBoxes, OptionButton, SpinButtons and TextBoxes. It has one property, called “PassedControl,” with an associated class-level variable, “m_PassedControl.” When m_Passed_Control is set, the code determines its type and assigns it to the appropriate WithEvents control. So, if the passed control is a TextBox the “txt” variable is set to m_Passed_Control. The last routine just prints the control’s name, as a stand-in for the real work that your class could do.

Private m_PassedControl As MSForms.Control
Private WithEvents chk As MSForms.CheckBox
Private WithEvents cbo As MSForms.ComboBox
Private WithEvents lst As MSForms.ListBox
Private WithEvents opt As MSForms.OptionButton
Private WithEvents spn As MSForms.SpinButton
Private WithEvents txt As MSForms.TextBox

Property Set ctl(PassedControl As MSForms.Control)
Set m_PassedControl = PassedControl

Select Case TypeName(PassedControl)
Case "CheckBox"
    Set chk = PassedControl
Case "ComboBox"
    Set cbo = PassedControl
Case "ListBox"
    Set lst = PassedControl
Case "OptionButton"
    Set opt = PassedControl
Case "SpinButton"
    Set spn = PassedControl
Case "TextBox"
    Set txt = PassedControl
End Select
End Property

Private Sub cbo_Change()
PrintControlName
End Sub

Private Sub chk_Click()
PrintControlName
End Sub

Private Sub lst_Change()
PrintControlName
End Sub

Private Sub opt_Click()
PrintControlName
End Sub

Private Sub spn_Change()
PrintControlName
End Sub

Private Sub txt_Change()
PrintControlName
End Sub

Sub PrintControlName()
Debug.Print m_PassedControl.Name
End Sub

The event routines above are just a sample. You can use as many events as are supported by that type of control. For example, a ComboBox supports the click, DropButtonClick, KeyUp and Mousedown events, among others. One limitation is that WithEvents controls don’t support Exit and Enter (and some other) events, as those are actually generated at the Userform level. To see which events are supported by a certain type of control, use the two dropdowns at the top of the class module:

WithEvents event types

One thing to note above is that I used the “TypeName” function rather than something like TypeOf ctl Is MSForms.ComboBox. One reason is that you can’t seem to use TypeOf in a Select Case statement. The second is that some controls return True for multiple types. For example, the OptionButton passes both “Is MSForms.OptionButton” and “Is MSForms.CheckBox.” I assume this is because the OptionButton is based on the Checkbox.

Here’s the initialization code in the UserForm. As promised, it’s very simple.

Public collControls As Collection
Private cMultipleControls As clsMultipleControls

Private Sub UserForm_Activate()
Dim ctl As MSForms.Control

Set collControls = New Collection
For Each ctl In Me.Controls
    Set cMultipleControls = New clsMultipleControls
    Set cMultipleControls.ctl = ctl
    collControls.Add cMultipleControls
Next ctl
End Sub

This code establishes a collection of instances of clsMultipleControls, one for each control in the form. Each class instance has an instantiated m_Passed_Control variable, and no more than one instantiated WithEvents control. I say “no more than one” because with this setup, although a CommandButton would generate a class, there’s no WithEvents CommandButton variable, so it wouldn’t be identified in the class’s Set ctl subroutine.

UserForm in action

I suppose this might be seen as inefficient, stuffing all these possibilities into a single class. But I like the way it simplifies the form coding and the flexibility of the class. What do you think?

In the next post, I’ll expand this class a bit and demonstrate what I think is a nice use for this type of class. I’ll also show a situation where TypeOf is required (I think), the problem that creates and the solution I came up with.

Meanwhile, here’s a downloadable workbook with the UserForm and class.

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.