Evaluate ActiveCell’s Table Row

Structured table references are pretty easy to generate in Excel. You know, the ones that look like:

Structured Reference

I recently realized you can use those structured references in a VBA Evaluate function to build strings based on the active row of a table. This makes for shorter code and avoids the use of Intersect, ListRow and ListColumn functions.

For example, let’s pretend you have a table of Oscar winners by year and you want to build a short sentence for each row of the table. Maybe you get a lot of emails from people asking what movie won the award in a given year. With a table like the one below you can simply choose the applicable row of column C and copy and paste it into your reply.

Per Row Output

This works okay, but it’s clunky. Instead, I’d rather generate the phrase in VBA based on the row of the ActiveCell. It was while writing this I had the happy thought to use VBA’s Evaluate function.

The Evaluate function basically returns the value of whatever you are evaluating as if it was entered in the active cell. At least that’s how I think of it for this instance. So, in the usage below, the structured reference’s @ symbol, e.g., [@Year] means “the value of the Year field in the active row of the table.”

It has two forms, one where you spell out Evaluate and one where you use square brackets, like I’ve done below.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim BestPicString As String

'only proceed if the ActiveCell is in the table body
On Error Resume Next
If Intersect(ActiveCell, ActiveCell.ListObject.DataBodyRange) Is Nothing Then
   Exit Sub
End If
On Error GoTo 0

BestPicString = _
   ["Best Picture for " & tblBestPics[@Year] & CHAR(10) & "was " & tblBestPics[@Film]]
wsBestPics.Range("cellBestPic").Value = BestPicString
End Sub

Active Row Output to Cell

I did this because when I use the brackets I don’t have to double the quotes. I’m not absolutely sure of this, but here are the two versions of Evaluate that work for me:

BestPicString = Application.Evaluate _
   ("=""Best Picture for "" & tblBestPics[@Year] & CHAR(10) & ""was "" & tblBestPics[@Film]")

and

BestPicString = _
   ["Best Picture for " & tblBestPics[@Year] & CHAR(10) & "was " & tblBestPics[@Film]]

One more thing to note is that both versions error when I don’t include the table name – tblBestPics – although that’s not necessary in an actual Excel formula where you could just refer to [@Year].

Below is the code that I would write if I wasn’t using the Evaluate function. It’s not bad, but requires more variables and logic:

Sub Alternative()
Dim lo As Excel.ListObject
Dim ActiveTableRow As Long
Dim BestPic As String
Dim BestPicYear As String
Dim BestPicString As String

On Error Resume Next
If Intersect(ActiveCell, ActiveCell.ListObject.DataBodyRange) Is Nothing Then
   Exit Sub
End If
On Error GoTo 0

Set lo = ActiveCell.ListObject
'header row is DatabodyRange.Rows(0)
ActiveTableRow = ActiveCell.Row - lo.DataBodyRange.Rows(0).Row
BestPicYear = lo.ListColumns("Year").DataBodyRange.Rows(ActiveTableRow)
BestPic = lo.ListColumns("Film").DataBodyRange.Rows(ActiveTableRow)
BestPicString = "Best Picture for " & BestPicYear & vbCrLf & "was " & BestPic
wsBestPics.Range("cellBestPic").Value = BestPicString
End Sub

Password Form With CapsLock Warning and Show Password

This post covers a password form I’ve developed developed and am adding to my database-connected utilities.

As I’ve mentioned, I use Excel mostly as a development environment for database queries. So, along with tools like SQL Developer and SQL Server Management Studio, I run and test a lot of my SQL right in Excel. This lets me use all of its filtering, pivoting and other data features to explore and validate query results. I recently even developed a data dictionary in Excel which queries database metadata for helpful information about the tables, fields, foreign keys, etc.

We adhere to an old-school coding style in my workplace. We don’t alias our tables with meaningless one-letter names and we type our SQL in ALL CAPS. I like this, but it means that I often typo case-sensitive passwords because CapsLock is on. So I’m updating my password entry to include a CapsLock check. And while I’m at it I’m adding a “show text” button. And, as often happens when I make something I like, I’m sharing my password form with you.

The Form

In the GIF below, CapsLock was on when the form was called. Once the user clicks in the password textbox the CapsLock warning is displayed. The CapsLock check is called from the textbox’s Enter and KeyUp events, in case it’s pressed while typing the password. The warning is turned off in the Exit event.

You can also see the Show Password feature in action. It’s just a toggle button that switches the textbox’s PasswordChar from “*” to “”.

password form in action

The code includes the GetKeyState API code I found on the web and modified. In the downloadable example below the password form is called from a main module and the username and password are passed back from the form, as in my flexible chooser form post.

Features I Didn’t Add

For a while I made it so that clicking the Show Textbox button put the focus back into the password textbox. This was cool, but harder to code with a predictable circular event between the textbox and the togglebutton. Also, it seemed like overkill for a password form that you won’t be spending much time with. The other thing I looked at was having the Show Textbox control engage only while it was pressed, which seems more secure from shoulder-hackers.

Do you have a password form or suggestions for this one?

Download

Here’s a sample workbook with the form.

Workbook-level Listobject QueryTable Properties Manager

Here’s a utility I’ve used for years. It lets you manage True/False properties for structured tables with data connections – for example BackgroundQuery and PreserveColumnInfo. You can change properties for all tables in a workbook at once, or just one or a few tables.

ListObject QueryTable Properties Form

I only added some properties to the form. One of these, MaintainConnection, can’t be found in Excel’s front end, and the others appear in two different dialog boxes. So being able to change them for multiple tables in one dialog is really nice. For example, above I’d select all three tables using Ctrl-A and uncheck AdjustColumnWidth and MaintainConnection. You can see that currently both highlighted tables have AdjustColumnWidth turned off. Also, a gray checkmark, like the one for MaintainConnection, means that some selected tables have it turned on but others don’t.

Features

  • Select which tables to modify. Ctrl-A selects all tables in the workbook. The Choose Current Table button selects the table where the active cell is located.
  • The current settings for the selected tables are shown by the state of the checkboxes. The checkboxes are triple-state, so if the property is true for only some of of the selected tables, the checkmark will be gray, as with MaintainConnection in picture.
  • To change properties for selected tables, set them with the checkboxes, then click Apply.
  • Double-clicking a table activates the sheet it’s on.
  • To add another property to the VBA form, simply add a checkbox inside the grpProperties frame of the form. The checkbox caption must be the exact name of a Boolean property.

The VBA

I hadn’t looked at the VBA for this for a while, except to add MaintainConnection a year or so ago. The code was clunky in that it referred to each property individually in a couple of places, something like:

lo.QueryTable.MaintainConnection = me.chkMaintainConnection.Value
lo.QueryTable.BackgroundQuery = me.chkBackgroundQuery.Value

… and so on for each property/checkbox assignment.

I realized that CallByName would work great here. If you don’t know it, CallByName is kind of like an INDIRECT function for object properties and methods. So instead of the list above, I used something like this inside of a loop:

CallByName lo.QueryTable, ctl.Caption, VbLet, chk.Value
  • lo.QueryTable is the QueryTable object
  • ctl.Caption contains the property name, e.g., MaintainConnection
  • chk.Value is the value of the checkbox, i.e. True or False

To see the actual code and the working form go to the download link below.

A note about MaintainConnection

I’ve mentioned MaintainConnection a couple of times now. It’s the key to an issue that comes up once a year or so, and adding this property to the form helps me remember the solution.

The issue occurs when connecting a structured table to another workbook. If MaintainConnection is True and I refresh the table, it locks the source workbook and it can’t be edited. I tried changing the connection to read only and fiddling with other connection settings, but setting MaintainConnection to false solves the issue. And this form makes it easy to do for every table in the workbook.

Download

Here’s a sample workbook with the form and some tables to test it on. Let me know what you think!

Tabbing and Viewing Workbooks on Two Monitors

I often have two workbooks up on two monitors. And of course I have a bunch of other programs open. I used to struggle to view both workbooks at the same time. Using Ctrl + TAB hides the first one as it shows the second one. Two workbooks tiled side-by-side on one monitor have the same issue. The solution I’ve found is to tab “backwards” using Shift + Ctrl + TAB.

The Ctrl + TAB Problem

Below I’m clicking Ctrl + TAB. As soon as the next workbook appears the first one goes away. It seems to go behind the Windows Explorer Window:

Ctrl + TAB

Shift + Ctrl + TAB to the Rescue

Below, I’m using Shift + Ctrl + TAB to cycle “backwards” through the workbooks. For whatever reason, now the first workbook stays visible, and I can see both:

Shift + Ctrl + TAB

This is one of my favorite keyboard tricks. Any explanations of what’s going on would be greatly appreciated, as would any better solutions.

Creating a History Navigation System

I’m working on an Excel workbook that’s a database dictionary. It has a data-validation list of all the tables in the database. Picking a table in the list updates a query that returns info about that selection. I’d like to keep a history of tables I’ve already looked at and get back to them quickly by clicking buttons or picking them from a history list. So I came up with a history navigation system.

The simple example for this post lets you quickly return to years of National League home run stats that you’ve already viewed.

History Navigator overview

What Kind of History do I want?

Two familiar examples of navigation history are those in browsers and file explorers. I’m in an out of Windows File Explorer all day long and use the history a lot. I like the way it works, but it seems silly that it includes the same folder multiple times.

File Explorer history

Firefox history doesn’t do that and just lists each visited page once. The thing that I don’t necessarily like is that if you hit the back button and then do a new search you lose the page that you “backed” from.

Firefox history

My Philosophy of History

After thinking about the above patterns for at least five minutes, I decided how I want history to work:

  • All previous choices made are included in the history for as long as the workbook is open.
  • Each previous choice is only included once.
  • If it’s already in the list, it’s moved to the most recent position when it’s chosen again.

The Code

It’s pretty simple, so I’m not going to go into it. You can see it by downloading the sample below. I used Form buttons so that I could assign the same subroutine to both of them without having to use WithEvents. Most of the logic has to do with updating the data validation list that has the history and updating the Prev and Next buttons. I’ve implemented this code in my data dictionary and it’s working well.

navigation history

Download

Here’s a sample workbook with the setup and code. Let me know what you think!

customUI Ribbon XML Editor

I’ve created a new addin for editing and validating Ribbon customUI XML. It’s a form that lets you modify ribbons in workbook and addins. Here’s a couple of screenshots:

form with highlighted error

form_with tips

YouTube Video and customUI Ribbon XML Editor

Here’s a YouTube video! yoursumbuddy’s first!

Here’s the link to the yoursumbuddy customUI Ribbon Editor page, where you can download it and read more.

Please let me know what you think.

RaiseEvent for Multiple UserForm Controls

This Stack Overflow answer solves the problem: How can a form receive events from multiple instances of a WithEvents class? The simple answer is to use RaiseEvent but the problem is that when you create a collection of WithEvents classes, the RaiseEvent only works for the last class instance added to the collection. This post shows you how to connect each WithEvents control to a RaiseEvent using a delegate class and receive the event in the form. For example, you could have changes to any one of a group of textboxes trigger a change in another form control.

(When I came across the Stack Overflow post above I read the explanation but not the code. I let it bounce around my brain for a couple of days and then got the main point that you can just funnel the WithEvents control to the delegate when the WithEvents control fires. After that, writing the code was easy.)

Review: Create a Textbox WithEvents Class

In past posts I’ve discussed UserForm code that creates a collection of WithEvents classes to capture changes to all the textboxes:

Private cEvents As clsEvents
Public collControls As Collection

Private Sub UserForm_Activate()
Dim ctl As MSForms.Control

Set cDelegate = New clsDelegate
Set collControls = New Collection
For Each ctl In Me.Controls
   If TypeOf ctl Is MSForms.TextBox Then
      Set cEvents = New clsEvents
      Set cEvents.cDelegate = cDelegate
      Set cEvents.txtBox = ctl
      collControls.Add cEvents
   End If
Next ctl
End Sub

clsEvents looks like this:

Public WithEvents txtBox As MSForms.TextBox

Private Sub txtBox_Change()
debug.print "Textbox changed"
End Sub

That’s nice for creating a message, or opening a file, or some other action outside the form. But sometimes you want to receive the event in the form and use it as a trigger to change other form controls.

You can add an Event to clsEvents so that it can be raised in the txtBox_Change event and received by another class, such as a form, but again the problem is that only the last textbox added to collControls will raise the event. Previously, I’ve coded around that by passing a reference to the userform into clsEvents, and manipulated the form from the class. It works, but it’s dirty. Plus I think it creates a memory leak.

Modification to allow multiple RaiseEvents

The solution is to create another class, a delegate, that is also instantiated in the userform. The delegate has a single public control property that is set by any of the clsEvents instances, one at a time, as their txtBox_Change event fires. When the txtBox variable is passed to the cDelegate it raises its txtBox_Changed event, which is then received by the cDelegate_Change routine back in the form. This way there’s only one instance of cDelegate, but its txtBox variable refers to whichever clsEvents textbox has changed most recently.

Delegate Diagram

Here’s the code for clsDelegate:

Public Event txtBoxChanged(txtBox As MSForms.TextBox)

Public Sub PassControl(txtBox As MSForms.TextBox)
RaiseEvent txtBoxChanged(txtBox)
End Sub

So simple! And here’s the modified code for clsEvents:

Public WithEvents txtBox As MSForms.TextBox
Private m_cDelegate As clsDelegate

Public Property Set cDelegate(value As clsDelegate)
Set m_cDelegate = value
End Property

Private Sub txtBox_Change()
m_cDelegate.PassControl txtBox
End Sub

m_cDelegate holds the reference to the cDelegate instance that’s passed to clsEvents, so it can pass its txtBox instance to the delegate class. In the form code below you can see where cDelegate is instantiated and where that instance is passed to each cEvent instance:

Private cEvents As clsEvents
Public WithEvents cDelegate As clsDelegate
Public collControls As Collection

Private Sub UserForm_Activate()
Dim ctl As MSForms.Control

Set cDelegate = New clsDelegate
Set collControls = New Collection
For Each ctl In Me.Controls
   If TypeOf ctl Is MSForms.TextBox Then
      Set cEvents = New clsEvents
      Set cEvents.cDelegate = cDelegate
      Set cEvents.txtBox = ctl
      collControls.Add cEvents
   End If
Next ctl
End Sub

Private Sub cDelegate_txtBoxChanged(txtBox As MSForms.TextBox)
Me.Label1.Caption = txtBox.Name & " text length is " & Len(txtBox.Text) & "." & vbCrLf & "Text is: " & vbCrLf & txtBox.Text
End Sub

The last sub in the code is the receiving event. It just updates information about whatever textbox was changed last.

textbox changes

Download!
Here’s a sample workbook with the form and code. Let me know what you think!

Excel and Kitchen Remodeling

“Excel and kitchen remodeling?”, you ask? What can they have in common? Sad to say, not much. In fact they seem to be mutually exclusive. Sure, at first I was able to throw together some budgets and even a cool little to-scale grid drawing worksheet. But now? Who has time? It’s all I can do to drag my weary ass to work after a weekend of schlepping stuff and picking out faucets (and counters, paint, floors, lights, so many bloody choices). Not to mention the massive time-consumption of cooking in the living room and washing up in the basement half-bath.

There is a light at the end of this tunnel though, and by it I glimpse a future where more than three people can eat at our table without claustrophobia and where we will open the dishwasher and fridge at the same time, just because we can.

Equally important, I envisage a time when I can once again blog and regale you with tales of ever-more quirky and complex bits of VBA. I can’t tell you how much I’m looking forward to it.

In the meantime you can always revisit my classic self-referencing picture post.

I notice that my first paragraph has a decidedly British tilt. In case you didn’t know “washing up” refers to dishes, not bodies. I still remember my mom’s look of surprise when on a trip to Europe a friend announced he was going to wash up and headed to the kitchen sink, and her look of relief when he started scrubbing a pot.

Speaking of which, I’ve got to go so I can pick out a new dishpan. Pardon me, I mean a new “washing-up bowl”.

washing up bowl

Just kidding.

Some Things I Learned Lately

Seems like every day I pick up something new. So I thought I’d make a quick list of stuff I’ve learned lately.

1) XMLAGG in Teradata
Teradata’s handy XMLAGG function lets lets you flatten a column of data into a delimited list, thereby avoiding recursion. Oracle, to which I’m migrating, also has an XMLAGG function but the closer, and better-named, equivalent seems to be LISTAGG. The Teradata documentation is consistently terrible, so instead I’ll link to this Stack Overflow answer from the worthy dnoeth.

2) 64-bit Office Text File Connection Strings
While updating a fancy data-sucking addin I got an error message that my data connection was broke. Turns out MS changed the ODBC connection string for 64-bit ever so slightly from:

Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=c:\txtFilesFolder\;Extensions=asc,csv,tab,txt;

to

Driver=Microsoft Access Text Driver (*.txt, *.csv);Dbq=c:\txtFilesFolder\;Extensions=asc,csv,tab,txt;

There’s two differences. The addition of the word “Access” was quickly apparent when looking at this site. The second one took me some time to spot. Can you see it? Yup, they changed the semicolon after “*.txt” to a comma. I think it looks a lot better.

3) Format vs WorksheetFunction.Text in VBA to Mimic Cell Formats
I’ve done a couple of posts that attempt to give you a sneak preview of how different formats will look when applied to cells. I was using my ActiveCell Viewer to preview different date formats for a cell. The Viewer used the VBA Format function. I noticed that in some cases it returned text that isn’t what you get in a cell with that formatting.

For instance, below I’ve applied a formatting of an increasing number of “d”s to a date. With formatting of two to four “d”s the two outputs match:

format differences 1

However with 5 or 6 “d”s the VBA function begins to return a weird result that doesn’t match what you’d see in a cell with that formatting:

format differences 2

You can see below that a cell formatting of “dddddd” still returns “Friday,” just like WorksheetFunction.Text. In fact if you close the Format Cells dialog and re-open it, you’ll see that the formatting has been reset to “dddd”.

format differences 3

I’ve since fixed my Activecell Viewer and added some features. I’ll try to remember to post the improved version sometime.

4) You Can Undo a Pivot Table Refresh
Who knew? All these years I assumed you couldn’t. And then I tried it.

pivot table unrefresh

5) Pivot Table Grouped Number Ranges, Once Sorted, Can’t Be Forced Back to Numeric Order
At least I can’t figure out how.

pivot number ranges grouped and sorted

Can you?

Locating PivotItem Subtotals

I’m either on a roll or in a rut: here’s one more post about pivot field stuff. Last time I posted about determining whether a give pivot field has visible subtotals. This time I’ll tell you how to find them. The solution again relies on my new friend, the PivotCell object. My main function actually locates PivotItem subtotals, not a PivotField’s. I then wrap that function in another routine to deal with all of a PivotField’s PivotItems.

Here’s the VBA:

Function GetPivotItemSubtotalRanges(pvtItem As Excel.PivotItem) As Excel.Range()
Dim pvt As Excel.PivotTable
Dim pvtField As Excel.PivotField
Dim cell As Excel.Range
Dim ItemTester As Excel.PivotItem
Dim PivotItemSubtotalRanges() As Excel.Range

If Not pvtItem.Visible Then
   Exit Function
End If

'I can't figure a better way to get the containing pivot table
Set pvt = pvtItem.DataRange.Cells(1).PivotTable
Set pvtField = pvtItem.Parent
'Cells with subtotal PivotCellType are in ColumnRange or RowRange
For Each cell In Union(pvt.ColumnRange, pvt.RowRange)
   Set ItemTester = Nothing
   On Error Resume Next
   'Only test cells with an associated PivotItem
   Set ItemTester = cell.PivotItem
   On Error GoTo 0
   With cell.PivotCell
      If Not ItemTester Is Nothing Then
         If (.PivotCellType = xlPivotCellSubtotal Or .PivotCellType = xlPivotCellCustomSubtotal) And cell.PivotField.DataRange.Address = pvtField.DataRange.Address And cell.PivotItem.DataRange.Address = pvtItem.DataRange.Address Then
            RedimRanges PivotItemSubtotalRanges
            If pvtField.Orientation = xlColumnField Then
               Set PivotItemSubtotalRanges(UBound(PivotItemSubtotalRanges)) = Intersect(cell.EntireColumn, pvt.DataBodyRange)
            ElseIf pvtField.Orientation = xlRowField Then
               Set PivotItemSubtotalRanges(UBound(PivotItemSubtotalRanges)) = Intersect(cell.EntireRow, pvt.DataBodyRange)
            End If
         End If
      End If
   End With
Next cell

GetPivotItemSubtotalRanges = PivotItemSubtotalRanges
End Function

How It Works

Be sure to read the previous post on this topic for background of how I got here.

With that background in hand, what the function above does is fairly simple. It loops through the RowRange and ColumnRange of a PivotItem’s pivot table. It looks for cells with a Range.PivotItem property that matches the PivotItem passed to the function, and which have a Range.PivotCellType of Subtotal or CustomSubtotal. If so then that PivotItem subtotal range is set to the intersection of the pivot table’s DataBodyRange and the row or column of the cell being tested. The subtotal range is added to the array of subtotal ranges returned by the function.

The PivotField Routine

Here’s an example of using the GetPivotItemSubtotalRanges function. This Sub takes a PivotField as its argument and selects all of it’s subtotals.

Sub SelectPivotFieldSubtotals(pvtField As Excel.PivotField)
   Dim pvtItem As Excel.PivotItem
   Dim PivotItemSubtotalRanges() As Excel.Range
   Dim PivotFieldSubtotals As Excel.Range
   Dim i As Long

   If Not PivotFieldSubtotalsVisible(pvtField) Then
      MsgBox "No Visible Subtotals"
      GoTo exit_point
   End If
   For Each pvtItem In pvtField.PivotItems
      If pvtItem.RecordCount > 0 Then
         PivotItemSubtotalRanges = GetPivotItemSubtotalRanges(pvtItem)
         For i = LBound(PivotItemSubtotalRanges) To UBound(PivotItemSubtotalRanges)
            If PivotFieldSubtotals Is Nothing Then
               Set PivotFieldSubtotals = PivotItemSubtotalRanges(i)
            Else
               Set PivotFieldSubtotals = Union(PivotFieldSubtotals, PivotItemSubtotalRanges(i))
            End If
         Next i
      End If
   Next pvtItem
   If i > 0 Then
      PivotFieldSubtotals.Select
   End If

exit_point:
End Sub

Stray Code Bits You’ll Need to Run the Above

This is the function that checks whether a PivotField has visible subtotals, and that I posted about previously:

Function PivotFieldSubtotalsVisible(pvtFieldToCheck As Excel.PivotField) As Boolean
Dim pvt As Excel.PivotTable
Dim cell As Excel.Range

With pvtFieldToCheck
   'Only row and column fields can show subtotals,
   If Not (.Orientation = xlColumnField Or .Orientation = xlRowField) Then
      GoTo exit_point
   End If
   Set pvt = .Parent
   For Each cell In Union(pvt.ColumnRange, pvt.RowRange)
      If cell.PivotCell.PivotCellType = xlPivotCellSubtotal Or cell.PivotCell.PivotCellType = xlPivotCellCustomSubtotal Then
         If cell.PivotCell.PivotField.Name = .Name Then
            PivotFieldSubtotalsVisible = True
            GoTo exit_point
         End If
      End If
   Next cell
End With

exit_point:
End Function

This one is because I want to hide the fact that I’m Redimming a lot:

Sub RedimRanges(ByRef SubtotalDataRanges() As Excel.Range)
If IsArrayEmpty(SubtotalDataRanges) Then
    ReDim SubtotalDataRanges(1 To 1)
Else
    ReDim Preserve SubtotalDataRanges(LBound(SubtotalDataRanges) To UBound(SubtotalDataRanges) + 1)
End If
End Sub

This is Chip Pearson’s array check:

Public Function IsArrayEmpty(Arr As Variant) As Boolean
'Chip Pearson
Dim LB As Long
Dim UB As Long

Err.Clear
On Error Resume Next
If IsArray(Arr) = False Then
    ' we weren't passed an array, return True
    IsArrayEmpty = True
End If
UB = UBound(Arr, 1)
If (Err.Number <> 0) Then
    IsArrayEmpty = True
Else
    Err.Clear
    LB = LBound(Arr)
    If LB > UB Then
        IsArrayEmpty = True
    Else
        IsArrayEmpty = False
    End If
End If
End Function

And this is what I attached to a button. Select a cell in a pivot table and if that cell’s PivotField has subtotals they will be highlighted:

Sub test()
SelectPivotFieldSubtotals ActiveCell.PivotField
End Sub

Subtotals Selected

In Conclusion

Whew! That feels like a lot of code with maybe not enough explanation. I plan to wrap up all this pivot field selection stuff soon with a post about my new-and-improved Per-Item Conditional Formatting tool.