Regex Cell Searcher

Regex Cell Searcher

My data is are of course always perfectly formed, so should I ever need to do something as mundane as copy and paste one of them – a datum that is – into another application I would just select the entire cell and copy and paste it. I’d never need something like a Regex Cell Searcher, aka reg(Excel)lsearcher, to parse my datum, er data, no … datum. Whatever.

But say I did. Say I had wanted to select a cell and instantly have all the phone numbers in that cell plunked into a listbox.

And imagine I could type regexes really fast:

regex cell searcher in action

And let’s also say I wanted to pluck the area codes from the same cell using regex submatches:


And say – just daring to dream here – I wanted the first phone number in the listbox automatically copied to the Windows clipboard. Like below, where I click the cell, the matches are found, and the first one is ready to be pasted into a search engine:

regex copy into clipboard

The Regular Expression

Here’s the regex I came up with to check for a phone number, which I’m defining as three numbers, bracketed or not by parentheses, followed by a space, dash or period, followed by three numbers, etc.:

(?:(\(?\d{3}\)?) ?[-\.]?)?\d{3}[-\.]\d{4}

I can see some issues with it. Regexes are finicky things and accounting for all the possibilities is tricky.

Happily, I’m one of those people with a love of regular expressions. When I bought a book recently for the first time in perhaps 10 years, it was Mastering Regular Expressions.

The Code

Here’s the routine that fills the listbox:

Private Sub UpdateResults()
Dim collMatches As Collection
Dim OneMatch As VBScript_RegExp_55.Match
Dim i As Long
Dim j As Long

If IsRegexPatternValid(Me.txtPattern) And Me.txtPattern <> "" Then
    Set collMatches = GetRegexMatches(Me.txtInput, Me.txtPattern)
    For i = 1 To collMatches.Count
        Set OneMatch = collMatches(i)
        lstMatches.AddItem OneMatch
        If OneMatch.SubMatches.Count > 0 Then
            For j = 1 To OneMatch.SubMatches.Count
                Me.lstSubMatches.AddItem OneMatch.SubMatches(j - 1)
            Next j
        End If
    Next i
End If
End Sub

And here’s the code that uses regular expressions to get the matches and submatches:

Function GetRegexMatches(InputString As String, SearchPattern As String, _
                         Optional boolIgnoreCase As Boolean = True, Optional boolGlobal As Boolean = True, Optional boolMultiline As Boolean = True, _
                         Optional UniqueMatches As Boolean = False) As Collection
Dim Regex As VBScript_RegExp_55.RegExp
Dim rgxMatch As VBScript_RegExp_55.Match
Dim rgxMatches As VBScript_RegExp_55.MatchCollection
Dim collMatches As Collection
Dim collUniqueMatches As Collection

Set Regex = New VBScript_RegExp_55.RegExp
With Regex
    .Pattern = SearchPattern
    .IgnoreCase = boolIgnoreCase
    'Find all matches, not just the first
   .Global = boolGlobal
    '^ and $ work per-line, not just at begin and end of file
   .MultiLine = boolMultiline
    Set collMatches = New Collection
    Set collUniqueMatches = New Collection
    If .test(InputString) Then
        'if matches, create a collection of them
       Set rgxMatches = .Execute(InputString)
        For Each rgxMatch In rgxMatches
            collMatches.Add rgxMatch
            On Error Resume Next
            collUniqueMatches.Add rgxMatch, rgxMatch
            On Error GoTo 0
        Next rgxMatch
    End If
End With

In addition to the features mentioned above, you can click on any item in the Match or SubMatch listboxes and that item will be copied to the clipboard. The form uses an Application class to track selections across all workbooks and is resizable using my form resizing code.

Regex in Excel Proper?

For those of you visiting the Excel User Voice site, where you can suggest and vote on future features in Excel, you may have noticed a fairly popular suggestion would add regex capabilities to Excel.


Here’s a workbook with the form and the code.

Close Workbook While Writing Over It

Close Workbook While Writing Over It

I appreciate that, when trying to copy over an open file, File Explorer gives me a chance to close the file and come back to resume the copy. It used to just stop, as I remember, but now it’s very nice:

folder is open warning

I’m not sure why the message says that a “folder” is open – I’m only trying to copy one file. That’s okay though, it’s clear enough what the message means (especially if you read it quickly). So, I just go into Excel, close the workbook and then go back to File Explorer and hit the “Try Again” button. I thought it would be helpful, or at least fun, to have a complementary function in Excel – a function that closes the workbook but allows me to immediately re-open it after finishing the copy

This is useful when saving to Excel from another program, like Crystal Reports, that exports to a workbook. Generally, I do the export, look at the output workbook, see something I want to change, go back into Crystal to fiddle, and export again*. Of course I can’t do the export if the workbook is still open, so I close it (if I remember) and then re-open it after the export. This requires using Excel’s Recent Files list, and if you read my last post you know I’m not a big fan.

So my most recent addition to my personal addin is a little routine that closes the active workbook and pops up a message box that “holds its place.” That way when I come back from saving over the just-closed file, I can re-open it with the click of a button:

close and hold
Here’s the code:

Sub CloseWbAndHold()
Dim WorkbookToClose As String

If ActiveWorkbook Is Nothing Then
    MsgBox "No active workbook."
    Exit Sub
End If
If ActiveWorkbook.Path = "" Then
    MsgBox "This workbook has no path."
    Exit Sub
End If

WorkbookToClose = ActiveWorkbook.FullName
ActiveWorkbook.Close False

If MsgBox("Re-open " & vbCrLf & WorkbookToClose & "?", vbYesNo + vbQuestion, "Re-open?") _
  = VbMsgBoxResult.vbYes Then
    Workbooks.Open WorkbookToClose
End If
End Sub

Note that the code closes the workbook without prompting to save, since I’m only planning to use it when I’m about to write over the workbook anyways.

And if I decide I want something even simpler, maybe I’ll just go with this:

Sub ReOpenLastFile()
If Application.RecentFiles.Count > 0 Then
    Workbooks.Open Application.RecentFiles(1)
End If
End Sub

* I’m happy to say that we use Crystal Reports mostly as a presentation layer for SQL, so I don’t often have to deal with formulas and the like in it.

Filter and Sort a Listbox With a Helper Table

Filter and Sort a Listbox With a Helper Table

I’ve been attempting to bend the Recent Files folder to my will for creating my own recent files form in Excel. My motivation is that Recent Files in Excel 2013 is one step further removed than in 2010. Now I’ve got a form that accesses all the Excel files in Windows Recent folder. I learned some interesting things putting it together, like how to extract a shortcut’s path in VBA. Even more interesting – instead of filtering and sorting the form’s main listbox using Like functions, arrays and collections, I just pull all the file data into a structured table and use it as the listbox’s source. When I want to sort or filter the listbox I just sort or filter the table and re-populate the listbox from the table. Much easier! No multi-dimensional array quicksorts or dictionaries required.

Recent Files form and table

In actual use, the sheet with the table is hidden (it’s in my utility addin), but above is a picture of the form and the table working together.


The Windows Recent Files list is some kind of semi-virtual folder that contains a bunch of shortcuts to the files you’ve opened since, well, I’m not sure when. In my Windows 10 and Windows 7 computers the path Environ("APPDATA")\Roaming\Microsoft\Windows\Recent gets me there.

One interesting thing about the Recent folder is that it contains workbooks that you create with code, which isn’t necessarily true in Excel’s Recent list. It also contains addins.

The folder looks like this:

Recent Files folder

It’s chock-full of all kinds of shortcuts. At first I thought I’d just use a FileBrowserDialog with the filter set to .xls* but that doesn’t work because the file types are really all .lnk. You can enter “.xl” in the Search box in the upper right and it will filter to just Excel files, but I can’t find a way to get something into the Search box using VBA.

So next I just plunked all the filenames into a sheet and added hyperlinks to the files that still exist (just like Excel’s recent files list, the shortcuts can outlive the files):

Recent Files sheet

That kind of works, isn’t a great interface for something like this. The thing that really doesn’t work is that without VBA you can’t click multiple hyperlinks at once.

So instead I turned that table into the source for a listbox on a userform. It’s got columns showing whether the file has been deleted, its modified date and full path:

Recent Files form

Filtering and Sorting the Listbox using the Tables Sort and Filter Objects

There it is nicely filtered to files that haven’t been deleted and other stuff sorted from newest to oldest, etc. And in order to get those nicely sorted dates, I just turned on the macro recorder and fiddled with some table-sorting VBA that it generated. Here’s the routine for the click event for the date-sorting label:

Private Sub lblFIleSort_Click()
Dim SourceTable As Excel.ListObject

If Me.lblFIleSort.Caption = "Unsorted" Then
    Me.lblFIleSort.Caption = "A to Z"
ElseIf Me.lblFIleSort.Caption = "A to Z" Then
    Me.lblFIleSort.Caption = "Z to A"
ElseIf Me.lblFIleSort.Caption = "Z to A" Then
    Me.lblFIleSort.Caption = "A to Z"
End If
Me.lblDateSort = "Unsorted"

Set SourceTable = ThisWorkbook.Worksheets("RecentFiles").ListObjects("tblRecentFiles")
With SourceTable.Sort
    .SortFields.Add Key:=SourceTable.ListColumns("File").Range, _
                    SortOn:=xlSortOnValues, _
                    Order:=IIf(Me.lblFIleSort.Caption = "A to Z", xlAscending, xlDescending), DataOption:=xlSortTextAsNumbers
    .Header = xlYes
    .Orientation = xlTopToBottom
End With
End Sub

That’s some pretty simple sorting code for a three-column listbox! The code for filtering it by filename is even shorter:

Private Sub txtFileFilter_Change()
Dim SourceTable As Excel.ListObject

Set SourceTable = ThisWorkbook.Worksheets("RecentFiles").ListObjects("tblRecentFiles")
SourceTable.Range.AutoFilter Field:=3, Criteria1:="=*" & Me.txtFileFilter.Text & "*", Operator:=xlAnd
End Sub

The last line of each sub above calls the FillLstRecentFiles subroutine, which plunks the visible rows in the helper table into the listbox:

Sub FillLstRecentFiles()
Dim SourceTable As Excel.ListObject
Dim VisibleList As Excel.Range
Dim SourceTableArea As Excel.Range
Dim SourceTableRow As Excel.Range
Dim Source() As String
Dim i As Long

Set SourceTable = ThisWorkbook.Worksheets("RecentFiles").ListObjects("tblRecentFiles")
On Error Resume Next
Set VisibleList = SourceTable.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If VisibleList Is Nothing Then
    GoTo Exit_Point
End If
For Each SourceTableArea In VisibleList.Areas
    For Each SourceTableRow In SourceTableArea.Rows
        i = i + 1
        ReDim Preserve Source(1 To 3, 1 To i)
        Source(1, i) = SourceTableRow.Cells(1)
        Source(2, i) = SourceTableRow.Cells(2)
        Source(3, i) = SourceTableRow.Cells(3)
    Next SourceTableRow
Next SourceTableArea
'If there's just one row
If i = 1 Then
    Me.lstRecentItems.AddItem (Source(1, 1))
    Me.lstRecentItems.List(0, 1) = Source(2, 1)
    Me.lstRecentItems.List(0, 2) = Source(3, 1)
    Me.lstRecentItems.List = WorksheetFunction.Transpose(Source)
End If

The main thing about the code above is that it cycles through the discontiguous Areas of the filtered table.

I’ve taken this code and added it to my main utility addin. Every time I open the utility it creates the sheet with the source table. When the form is closed the table gets deleted. It’s not terribly fast on a network when it first parses through all the files, so I don’t know how much I’ll actually use it. But I’m pretty sure I’ll be using listbox helper tables.

Have You Ever Used a Table Like This?

I’m curious whether you’ve ever used a table as a listbox helper like this. If so, how well did it work?


Here’s a download so you can try it out . It also has some nifty code for getting a shortcut’s path and other treats as well.


Delete Unselected Sheets From Workbook

Delete Unselected Sheets From Workbook

My time is short and so is my code. As a sort of companion piece to the recent post on removing filters from all but the selected columns, here’s some VBA to delete unselected sheets from a workbook. It’s a type of action I find useful. Often before I send a workbook to somebody I want to delete all but one or two sheets. Sure, I could select them, right click, choose delete and answer the confirmation prompt, but I’m not a young man. My time is precious, and since deleting sheets kills the Undo stack anyways, why not do it with code?

I could use two nested loops to test whether each sheet is one of the selected sheets, but I like this better:

Sub DeleteUnselectedSheets()
Dim SelectedSheetsCount As Long

If ActiveWorkbook Is Nothing Then
    MsgBox "No active workbook."
    Exit Sub
End If

SelectedSheetsCount = ActiveWindow.SelectedSheets.Count
If MsgBox("Really?", vbYesNo, "Delete Unselected Sheets") = vbNo Then
    Exit Sub
End If

ActiveWindow.SelectedSheets.Move before:=ActiveWorkbook.Sheets(1)
Do Until ActiveWorkbook.Sheets.Count = SelectedSheetsCount
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets(SelectedSheetsCount + 1).Delete
    Application.DisplayAlerts = True
End Sub

You’ll notice that I chickened out and put a confirmation dialog in there. Common sense got the better of me.

The Move command keeps the SelectedSheets in the same order and moves them to the leftmost positions. At that point only the first one is selected, which is why we saved the number of selected sheets at the beginning. The Do Until loop then deletes all the sheets with a higher index than the count of originally selected sheets.

I tested it on charts and hidden sheets and it worked fine:

delete unselected sheets

Selection.ListObject and Selection.PivotTable

Selection.ListObject and Selection.PivotTable

In recent posts about using VBA to work with filters I’ve used ActiveCell.ListObject to test whether I’m dealing with a filtered table or a filtered range. At one point it occurred that maybe I should be looking at the Selection’s ListObject instead. For various reasons that doesn’t work, but it made me wonder how Selection.ListObject gets evaluated. For example, what if it spans two tables? And, while we’re at it what about Selection.PivotTable?

To be clear, everything said about Selection in this post actually applies to the more general Range object. It’s just that Selection is the range I’m interested in.


Let’s start with Pivot Tables. Excel’s help actually says exactly how Range.PivotTable is handled:

Returns a PivotTable object that represents the PivotTable report containing the upper-left corner of the [Selection].

So, Selection.PivotTable returns an error with the selection below because its upper-left corner is outside the pivot:

pivot selection

But this selection will return the pivot table because the upper-left cell of the selection intersects the pivot table:

pivot selection 2


The rules for ListObjects, or at least what I’m guessing are the rules, are different. There’s nothing I can find in Help, so here’s what I made up:

Returns the ListObject intersected by the Selection. If more than one ListObject intersects the Selection, the ListObject that was created earliest is returned.

None of the pivot table’s “upper-left corner” stuff. If the selection intersects the table, the table is returned. So below Selection.Listobject returns Table3.

listobject selection 1

When the Selection intersects multiple ListObjects, it looks to me like Selection.ListObject returns the one that was created earliest. With the selection below, that means that it returns Table1.

listobject selection 2

In Conclusion

Now I have even more reasons to never use Selection.ListObject or Selection.PivotTable! They’re both quirky, and I don’t think I could expect users to know that if they select more than one table, they’ll get the oldest one (or for that matter, that they’d get any one). And for a pivot table, it would be kind of fussy to insist the upper-left corner of the selection be in the pivot table.

I’m sticking with ActiveCell. I think that’s the way Range.PivotTable and Range.Selection should have been designed as well. In other words, like Range.PivotTable does, only using ActiveCell instead of the upper-left corner.

Remove Filters From Other Columns

Remove Filters From Other Columns

Here’s another in what’s turning out to be a series of posts on AutoFiltering. This time it’s a bit of code to remove filters from all the columns except those that are part of the current selection. The idea is kind of like “Close Other Tabs” in Fireox or Notepad++. It works for Tables and plain old filtered ranges. I wrote it the other day while working on a mile-wide list with various fancy filters, most of which I wanted to get rid of.

It’s not much code, and hopefully it’s self-explanatory. (If not, you know where to find me.)

Sub ClearFiltersFromOtherColumns()
Dim i As Long
Dim AutoFltr As Excel.AutoFilter

If ActiveSheet Is Nothing Then
    MsgBox "No active worksheet."
    Exit Sub
End If
'Determine the range with the filter depending on whether it's a Table or not
If Not ActiveCell.ListObject Is Nothing Then
    Set AutoFltr = ActiveCell.ListObject.AutoFilter
    Set AutoFltr = ActiveCell.Parent.AutoFilter
End If
If AutoFltr Is Nothing Then
    MsgBox "The selection is not within filtered table or range"
    Exit Sub
End If
If Union(Selection, AutoFltr.Range).Address <> AutoFltr.Range.Address Then
    MsgBox "Please make sure all cells are within the same table or filtered area."
    Exit Sub
End If

For i = 1 To AutoFltr.Filters.Count
    If AutoFltr.Filters(i).On And _
       (Intersect(Selection.EntireColumn, AutoFltr.Range.Columns(i)) Is Nothing) Then
        AutoFltr.Range.AutoFilter Field:=i
    End If
Next i
End Sub

The part I like is how it narrows down to a aingle AutoFilter object regardless of whether you’re working with a ListObject or just a filtered range. I’m not sure I knew there was such an object until I read Mike Alexander’s post on A Better Way to Copy Filtered Rows Using VBA.

My Happy Birthday Contribution

My Happy Birthday Contribution

As Debra, Mike and others have mentioned today is Excel’s birthday. Woohoo!

I’ve been busy with actual paying Excel side jobs and other life stuff (which apparently is more “important” than blogging).

I did take this picture at my workplace the other day and want to share it with you. These bumper stickers are all around the building – just more proof of the awesomeness of my job. This was the first time I’d noticed this one:

Believe in Excel

So Happy Birthday Excel.

I believe in you. And trust you – even though you’re over 30.

Get Word Instance Functions

Get Word Instance Functions

Submitted for your approval. Three functions. Functions to do a simple job. Do it well. Or not. You be the judge.

Yes, I’m trying something new and hoping to drag you along. Don’t worry, it’s just a poll.

A poll about what?
I haven’t automated Word for quite a bit and so, to ease into it, I noodled around with all-purpose functions to find or create a Word instance.

Function Specs
This function, as I imagine it, would have one option with three choices. Or is that one choice with three options?

1. Return only an existing instance of Word. If no instances are open, return nothing.
2. Return an existing instance of Word. If none exists, create a new one.
3. Create a new instance of Word whether or not one’s already open.

That’s not what I want you to vote on. I think we can all agree there’s a time and place for each of these options.

What I want to know is which of the following functions you like best. They all do the same thing, with slightly different approaches.

Function #1 – Enums: I love ’em, or at least the idea of them. In this case we can use their bitwise ANDing capability to shorten, and perhaps obfuscate.

Public Enum WordInstanceType
    ExistingInstance = 1
    NewInstance = 2
End Enum

Function GetWordInstance(InstanceType As WordInstanceType) As Object
Dim wd As Object

If InstanceType And ExistingInstance Then
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo 0
End If
'If wd is nothing now it's either because there were no existing instances
'and/or we asked for New
If (InstanceType And NewInstance) And wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
End If
Set GetWordInstance = wd
End Function

Function #2 – FallThrough: It’s got an ugly pattern, but it matches the way I think about it. No enum, so you’d have to look at the function to figure out what strings it recognizes. That’s pretty ugly too, so maybe you’d want to change it to an enum.

Function GetWordInstance2(InstanceType As String) As Object
Dim wd As Object

If InstanceType = "ExistingInstance" Or InstanceType = "ExistingThenNew" Then
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo 0
    'If we only want Existing, then we either got it or not
   If InstanceType = "ExistingInstance" Then
        Set GetWordInstance2 = wd
        Exit Function
    End If
End If
'If wd is nothing now it's either because
'we specified ExistingThenNew and there were no existing instances
'or we specified NewInstance
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
End If
Set GetWordInstance2 = wd
End Function

Function #3 – Plodding Boy, I’m really selling these, huh? Like #2, no enum. It doesn’t worry about duplicated code, just lays out the steps for each option. A simple function for a simple man.

Function GetWordInstance3(InstanceType As String) As Object
Dim wd As Object

If InstanceType = "ExistingInstance" Then
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo 0
ElseIf InstanceType = "ExistingThenNew" Then
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo 0
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
ElseIf InstanceType = "NewInstance" Then
    Set wd = CreateObject("Word.Application")
End If

Set GetWordInstance3 = wd
End Function

So, okay, the poll. Which function do you prefer?

View Results

Loading ... Loading ...

Dynamically Resize Form Controls With Anchors

Dynamically Resize Form Controls With Anchors

Every once in a while I work on a VB.Net project. The coolest was building an interface connecting an ArcGIS front-end to a SQL Server backend… but that’s another story. One thing I always enjoy about Visual Studio, besides the post-1900s IDE, is the forms. They have many fine features, like rich textboxes you’re allowed to use, data-connected listviews and, perhaps my favorite, dynamically resizable controls. The resizing behavior is set using left, right, top and bottom “anchors.” You set the anchors right in the Properties dialog box:

dotNet anchor property

So of course, I decided to create anchors for my VBA forms. And I think I’ve succeeded:

My Form With Anchored Controls

yoursumbuddy form

The form above has two frames, a listbox, three textboxes and two commandbuttons. Their moorings are shown in this table:

anchor settings

How Do Anchors Work?

If you use only one anchor in a pair, like only the Left anchor, then the control moves when the form is resized, maintaining the same distance between the control and the left edge of its parent container. Its size doesn’t change. If you choose both Left and Right anchors then the control grows or shrinks horizontally to fit the parent container. It’s kind of like having left-justified, right-justified or distributed text in a cell:

left right anchor demo

In this imperfect analogy, the words are the controls and the cells are the parent containers. The same concept applies to Top and Bottom anchors.

Coding the Anchors

I used to do this kind of thing piecemeal by relating the position of one control relative to its form or another control:

old style code

It works, but it’s cumbersome and requires the use of things like a WIDTH_PADDING constant, an indication that I don’t quite know what I’m doing.

It took a while to figure out the logic for handling all the form’s controls no matter where the are on the form, what types of anchors they have and whether they’re inside another control or not. At first my formulas still looked a lot like the code above, attempting to accommodate the borders around parent controls and such.

The secret I found is to just relate the anchors to the original height and width of their parent control, whether that parent is the form itself or a frame within the form. Then you can just apply the change in width or height of the parent to the position and size of the child control:

The code to do this is in a class which you instantiate and populate from the form:

Public Sub ResizeControls()
Dim i As Long

For i = LBound(m_ControlsAnchorsAndVals) To UBound(m_ControlsAnchorsAndVals)
    With m_ControlsAnchorsAndVals(i)
        If .AnchorTop And .AnchorBottom Then
            .ctl.Top = .StartingTop
            .ctl.Height = Application.WorksheetFunction.Max(0, .StartingHeight + _
                (.ctl.Parent.InsideHeight - .ParentStartingHeight))
        ElseIf .AnchorTop And Not .AnchorBottom Then
            .ctl.Top = .StartingTop
        ElseIf Not .AnchorTop And .AnchorBottom Then
            .ctl.Top = .StartingTop + (.ctl.Parent.InsideHeight - .ParentStartingHeight)
        End If
        If .AnchorLeft And .AnchorRight Then
            .ctl.Left = .StartingLeft
            .ctl.Width = Application.WorksheetFunction.Max(0, .StartingWidth + _
                (.ctl.Parent.InsideWidth - .ParentStartingWidth))
        ElseIf .AnchorLeft And Not .AnchorRight Then
            .ctl.Left = .StartingLeft
        ElseIf Not .AnchorLeft And .AnchorRight Then
            .ctl.Left = .StartingLeft + (.ctl.Parent.InsideWidth - .ParentStartingWidth)
        End If
    End With
Next i
End Sub

m_ControlsAnchorsAndVals is an array of types, one element for each control. The type specifies which anchors apply to that control, the control’s original dimensions and its parent’s original dimensions:

Private Type ControlAnchorsAndValues
    ctl As MSForms.Control
    AnchorTop As Boolean
    AnchorLeft As Boolean
    AnchorBottom As Boolean
    AnchorRight As Boolean
    StartingTop As Double
    StartingLeft As Double
    StartingHeight As Double
    StartingWidth As Double
    ParentStartingHeight As Double
    ParentStartingWidth As Double
End Type

Here’s the Userform code that fills the array of Types, instantiates the class and assigns the eight controls and their anchors:

Private Sub UserForm_Activate()
'We know how many controls we're dealing with
Dim ControlsAndAnchors(1 To 8) As ControlAndAnchors

'Chip Pearson code
MakeFormResizable Me, True
ShowMinimizeButton Me, False
ShowMaximizeButton Me, False

With ControlsAndAnchors(1)
    Set .ctl = Me.Frame1
    .AnchorTop = True
    .AnchorLeft = True
    .AnchorBottom = True
    .AnchorRight = True
End With
With ControlsAndAnchors(2)
    Set .ctl = Me.Frame2
    .AnchorTop = True
    .AnchorBottom = True
    .AnchorRight = True
End With

'... etc

With ControlsAndAnchors(8)
    Set .ctl = Me.CommandButton2
    .AnchorBottom = True
    .AnchorRight = True
End With

Set cFormResizing = New clsFormResizing
cFormResizing.Initialize Me, ControlsAndAnchors
End Sub

Add a little Chip Pearson form resizing code and you’re good to go.

Some Important or Perhaps Interesting Stuff to Know if You Try This

  1. It’s important to add the controls to the array in order of their hierarchy. If you resize a control before its parent is resized it won’t work.
  2. The WithEvents userform object seems to lack a Resize event. It does have a Layout event, which occurs whenever the form or any control on it is moved or resized. I could have worked with that, but instead I call the class’s ResizeControls subroutine from the form’s Resize event.
  3. This project makes use of Chip Pearson’s excellent API form code, which allows you to resize, and add maximize and minimize buttons to, a form.
  4. After finishing this I did a search and found that Andy Pope (of course!) did something like it ten years ago. He uses an enum, which is always fun, and has some different features, like setting a minimum control size. Unless I’m mistaken though, his code relates the change in control size or position only to the overall form, not to the control’s parent container. This can lead to oddness if you have two side-by-side frames containing controls.


This download contains the code and form. It also has a copy of the table shown above that has the anchors listed for each control. I tied the table to the code so you can change the values of the anchors, run the form, and see how it behaves.

Be careful, or you might get something like this:

mixed up form

Pivot Multiple Worksheets

Pivot Multiple Worksheets

As I’ve mentioned before, these days I use Excel more and more for developing and testing SQL code. As part of that I often compare of sets of output from SQL. And as part of that I sometimes I find it useful to pivot multiple worksheets.

For example, I just finished a project of translating a query from one data warehouse to another. The new database has a completely different schema than the old – new tables, new fields, new behaviors. My goal was to develop a query that returned the same results from the new database as those from the old.

To compare the outputs, I created two tables (listobjects) in a single workbook. The first table had a connection to the old data warehouse and uses the old query as its Command Text. The second table is connected to the new data warehouse, and was where I’d test the SQL I was developing.

Especially at first, there were quite a few differences in the output of these two queries in these two tables. Comparing the outputs in a pivot table let me see these differences clearly, both in summary and in detail.

Here’s a very simple example using my trusty pie data. In this example I have two different tables on two sheets with slightly different pie orders. Here’s the output from data warehouse 1…

pie table 1

and here it is from data warehouse 88b…

pie table 2

I conveniently placed differences in the Quantity column near the top, so you may be able to just pick them out by eye. And you may even have caught the one date field discrepancy. However, after combining the two tables into one, adding a “Source” column and then pivoting, the differences become easy to pick out, especially with a little conditional formatting:

pie pivot comparison

In the pivot above, “2”s in the Grand Total column represent all the records where the two queries returned the same results. The “1”s point to the discrepancies.

This is a flexible and powerful comparison method. Benefits include:

  • You can quickly add or subtract fields from the pivot to pinpoint the differences.
  • You can change the orders of the fields.
  • If you add subtotals you can then double-click on those with disrepancies to drill down to just those results.

For a while I created these combined source tables manually, just pasting the two sets of results together, adding a column “Source” column with “DW_1” and “DW_88b.” This worked fairly well, but after several times it cried out for automation.

The VBA below keys off of selected sheets in a workbook. Just select the ones you want to pivot and then run the code. Here you can see that both sheets are selected, and I’ve added the “Pivot Multiple Sheets” macro to the tab’s right-click menu (with MenuRighter, of course).

ply menu

The code first collects all the data necessary for the connection and then closes the source workbook. (I did this to avoid memory leaks or whatever it is that makes things go wonky if the workbook is open at the same time I’m creating a connection to it.) It uses that data to create the Source and SQL strings. The SQL is just a series of SELECTS, one for each selected worksheet, connected with UNION ALLs.

The newly created worbook contains a table with the connection to the source workbook and a pivot table pointed at that table. The table’s “Source” field becomes a column in the pivot table, containing the names of the two or more worksheets. The rest of the table columns become pivot table row fields. The connection in this workbook is live, so that if you make changes to the source they will appear in this workbook once you refresh the data and pivot:

Sub Pivot_Multiple_Sheets()

Dim wbToPivot As Excel.Workbook
Dim SheetsToPivot As Excel.Sheets
Dim SourceFullName As String
Dim SourceString As String
Dim wbWithPivot As Excel.Workbook
Dim wsWithQueryTable As Excel.Worksheet
Dim SheetsToPivotCount As Long
Dim SheetsToPivotNames() As String
Dim qt As Excel.QueryTable
Dim i As Long
Dim SqlSelects() As String
Dim sql As String
Dim pvt As Excel.PivotTable
Dim pvtField As Excel.PivotField

If ActiveWorkbook Is Nothing Then
    MsgBox "No active workbook."
    Exit Sub
End If
Set wbToPivot = ActiveWorkbook

If Not wbToPivot.Saved Then
    MsgBox "Please save this workbook before running." & vbCrLf & _
                 "Workbook will be closed by this utility" & _
                 "after the process is completed."
    Exit Sub
End If

'This code acts on the Selected Sheets
Set SheetsToPivot = wbToPivot.Windows(1).SelectedSheets
If SheetsToPivot.Count = 1 Then
    MsgBox "Please select two or more worksheets (no charts)."
    Exit Sub
End If

SheetsToPivotCount = SheetsToPivot.Count

For i = 1 To SheetsToPivotCount
    If Not TypeName(SheetsToPivot(i)) = "Worksheet" Then
        MsgBox "Please select two or more worksheets (no charts)."
        Exit Sub
    End If
Next i

SourceFullName = wbToPivot.FullName
ReDim SheetsToPivotNames(1 To SheetsToPivotCount)
For i = 1 To SheetsToPivotCount
    SheetsToPivotNames(i) = SheetsToPivot(i).Name
Next i
'Change Selection to only one sheeet
'Close the source workbook before creating the new one and its connections
'Save it so not prompted
wbToPivot.Close True

Set wbWithPivot = Workbooks.Add
'Delete any extra worksheets
For i = wbWithPivot.Worksheets.Count To 2 Step -1
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
Next i
Set wsWithQueryTable = wbWithPivot.Worksheets(1)
wsWithQueryTable.Name = "Data Table"
'Don't know why this is needed, but otherwise .CommandText line below fails

'I got rid of a lot of fields in connection - still seems to work
SourceString = "ODBC;DSN=Excel Files;DBQ=" & SourceFullName
'Create an array of SELECT statements
ReDim SqlSelects(1 To SheetsToPivotCount)
For i = 1 To SheetsToPivotCount
    SqlSelects(i) = "SELECT" & vbCrLf & _
                    "'" & SheetsToPivotNames(i) & "' as Source," & vbCrLf & _
                    "Sheet" & i & ".*" & vbCrLf & _
                    "FROM" & vbCrLf & _
                    "`" & SourceFullName & "`.[" & SheetsToPivotNames(i) & "$] AS Sheet" & i
Next i
'Connect the SELECTS with UNION ALL
For i = LBound(SqlSelects) To UBound(SqlSelects) - 1
    sql = sql & SqlSelects(i) & vbCrLf & "UNION ALL" & vbCrLf
Next i
sql = sql & SqlSelects(i)

Set qt = wsWithQueryTable.ListObjects.Add(SourceType:=0, Source:=SourceString, Destination:=wsWithQueryTable.Range("$A$1")).QueryTable
With qt
    .CommandText = sql
    .ListObject.DisplayName = "tbl" & Format(Now(), "yyyymmddhhmmss") & Right(Format(Timer, "#0.00"), 2)
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    'I like it to preserve the widths the first time it's run, and below turn it to false
   .AdjustColumnWidth = True
    .Refresh BackgroundQuery:=False
    .AdjustColumnWidth = False
End With
With ActiveSheet
    .Name = "Pivot"
    Set pvt = .Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=qt.ListObject.Name).CreatePivotTable(TableDestination:=.Range("A1"))
    pvt.AddDataField Field:=pvt.PivotFields("Source"), Function:=xlCount
    With pvt.PivotFields("Source")
        .Orientation = xlColumnField
        .Position = 1
    End With
    For Each pvtField In pvt.PivotFields
        If pvtField.Name <> "Source" Then
            pvtField.Orientation = xlRowField
            pvtField.Position = pvt.RowFields.Count
        End If
    Next pvtField
End With
End Sub

To use this code put it in your Personal.xlsb or any workbook besides the one with the source data.

This code could use some more error-checking. For example, if the two sheets have a different number of columns. Even more important is the addition of whatever kind of general error handling you use so you exit gracefully from bad connection strings and other such inevitable problems.

Speaking of bad connection strings, you may notice that I’ve ditched the Default Directory, DriverId, BufferSize, MaxPageTimeOuts and whatnot from the connection. I did that to see if it worked. It did, so I never added them back. I see that they reappear in the connection properties for the table:

connection properties

I ran this code in Excel 2010 and 2013. I don’t know how portable this code is to other Excel versions. I also don’t know if you’ll have performance issues if you have the source and pivot workbooks open at the same time.

If you’re interested in this topic be sure to take a look at Kirill Lapin’s method, posted on Contextures. His method keeps the source and the pivot table in one workbook, deleting the connection in between refreshes of the pivot table. I think Kirill’s method is nice for more traditional pivot table use where you want to merge different data sets with the same format, e.g., eastern and western sales regions.

I like my method because it requires no setup for the source workbook, keeps a refreshable connection and arranges the pivot table for comparison.

I’d love to hear anybody’s opinion on the stability of this method, i.e., when opening both the source and the connected data at the same time. Also, I’m curious if this code works in other versions besides 2010 and 2013. These are areas where my knowledge is pretty piecemeal, so any help would be appreciated.