Flexible Chooser Form With Apply Button

“Apply” buttons in forms can be confusing. People sometimes think they have to hit Apply before they hit OK But OK really means “make the change and close,” while Apply means “make the change but don’t close.” Also, a Cancel button on a form with an Apply button doesn’t actually cancel actions that were applied, just those since the last apply. At least that’s the way it works in many Windows dialogs, like Windows Explorer’s:

win explorer apply cancel

Excel’s Conditional Formatting dialog adds an extra wrinkle. Below I’ve modified a rule to change the color for orange for macaroons. I haven’t hit Apply yet, so I could choose:

1. Apply to save the change and keep on working
2. OK to save the changes and exit
3. Cancel to exit without saving

CF Apply button 1

Once I hit Apply, the Cancel button changes to a Close button. At this point OK and Close mean the same thing: close the form. It seems like Close is just a placeholder for the Cancel button, which will reappear once I start to change something. It is nice that Close and Cancel actually mean what I’d expect with this dialog.

CF Apply button 2

A less confusing form might be one with just an Apply and a Close button. It’s really all you need, and the only downside haveing to click Apply and then Close instead of OK. I did this on one of my own utility forms, but in general I’ll keep using OK buttons because that’s the norm.

Adding an Apply Button to My Flexible Chooser Form

Back in A Flexible VBA Chooser Form I showed how to create a simple form to which you pass some values and which returns a choice. The example let the user pick from a list of pivot fields and then highlighted the field’s range and showsed some information about it. For this post, I modified that code to add an “Apply” button, so you can stay in the form and show info for different fields as long as you want.

Much of the form’s code is unchanged from the earlier post, so read it if you want more background. Its “ClosedWithOk” property is now a more flexible FormState one that stores whether the Apply, OK or Close button was clicked. The code that calls the form is also mostly similar, with a Do While loop added to manage the Apply button. Here it is:

Sub ShowPivotFieldInfo()

Dim pvt As Excel.PivotTable
Dim lo As Excel.ListObject
Dim StartingCell As Excel.Range
Dim i As Long
Dim FormState As String
Dim DoneWithForm As Boolean
Dim PivotFieldNames() As String
Dim pvtField As Excel.PivotField
Dim ChosenName As String

Set pvt = ActiveSheet.PivotTables("pvtRecordTemps")
Set lo = ActiveSheet.ListObjects("tblRecordTemps")
Set StartingCell = ActiveCell
With pvt
    ReDim PivotFieldNames(1 To .VisibleFields.Count) As String
    For i = 1 To .VisibleFields.Count
        PivotFieldNames(i) = .VisibleFields(i).Name
    Next i
    DoneWithForm = False
    Do While Not DoneWithForm
        ChosenName = GetChoiceFromChooserForm(PivotFieldNames, "Choose a Pivot Field", FormState)
        DoneWithForm = (FormState <> "Apply")
        If ChosenName = vbNullString Then
            GoTo Exit_Point
        End If
        Set pvtField = .PivotFields(ChosenName)
        With pvtField
            Union(.DataRange, lo.ListColumns(.SourceName).DataBodyRange).Select
            MsgBox Title:=.SourceName, _
                   Prompt:="The SourceName for " & ChosenName & " is:" & vbCrLf & vbCrLf & .SourceName
        End With
    Loop
End With

Exit_Point:
StartingCell.Select
End Sub

I had to add a ByRef variable, “FormState,” to the function that initializes and gets the choice from the userform. That’s because, in addition to returning the choice, this function now returns whether the OK, Apply or Close button was clicked:

Function GetChoiceFromChooserForm(strChoices() As String, strCaption As String, ByRef FormState As String) As String
Dim ufChooser As frmChooser
Dim strChoicesToPass() As String

ReDim strChoicesToPass(LBound(strChoices) To UBound(strChoices))
strChoicesToPass() = strChoices()
Set ufChooser = New frmChooser
With ufChooser
    .Caption = strCaption
    .ChoiceList = strChoicesToPass
    .Show
    FormState = .FormState
    If Not FormState = "Close" Then
        GetChoiceFromChooserForm = .ChoiceValue
    End If
End With
End Function

Pivot field lister with apply

Download?

I’m glad you asked. Here it is.

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.

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.

Pivot Table Per-Item Color Scales

Let’s take another journey to the nexus of conditional formatting and pivot tables. My latest foray involved adding per-item color-scales to a pivot table, something like this, where the color scale is applied separately to each quarter:

color scale by quarter

You can see, for example, that the very high sales of $9,999,999 for January in Region 1 affect the color scale for the other cells in Quarter 1. However, the color scale within other quarters are unaffected, and a 99,999 value in Quarter 2 gets the same green that the much higher value did in Quarter 1.

Here’s another view with each month getting its own scale:

color scale by month

Finally, this shows icon sets by region. Notice that although they span each region for all months, the icon sets ignore the subtotals, which is often preferable:

icons by region

My code allows you to include or include or ignore subtotals in each item’s color scale. I went about this a couple of ways before settling on the PivotTable.PivotSelect method. I learned about this method recently in a comment by Mike Alexander on one of Jeff Weir’s massive DDOE posts. I can’t find any good documentation, but in Excel 2007 forward you can do things like:

pvt.PivotSelect "'Row Grand Total'", xlDataOnly

Select a pivot table’s Row Grand Total area

pvt.PivotSelect "'Region'['East';Data]", xlDataOnly

Select the data rows for the East PivotItem of the Region PivotField

(There is a PivotSelect method in 2003, but these types of statements failed.)

It looks like PivotSelect is the VBA version of clicking, for example, a single subtotal in a pivot table and thereby selecting them all. I figured out the syntax by turning on the Macro Recorder and doing those types of selections:

selecting pivot parts in Excel

I’m not crazy about using PivotSelect – I assume all that selecting will slow things down on big pivot tables. On the other hand it seems to work consistently. I had much more complicated code that worked most of the time, but only most.

Here’s the code, which runs in Excel 2007 on:

Sub PivotItemCF(pvtFieldToFormat As Excel.PivotField, IgnoreSubtotals As Boolean)
Dim pvt As Excel.PivotTable
Dim pvtItem As Excel.PivotItem
Dim pvtField As Excel.PivotField
Dim rngTest As Excel.Range

'Lots of selecting!
Application.ScreenUpdating = False

Set pvt = pvtFieldToFormat.Parent
With pvt
    For Each pvtItem In pvtFieldToFormat.PivotItems
        'A distressing number of possible errors from hidden items.
        'If the item has no DataRange ignore it.
        On Error Resume Next
        Set rngTest = pvtItem.DataRange
        If Err.Number = 0 Then
            'Specify the Field name in case there are multiple items
            'with the same name,for example from Grouping.
            'Surround PivotItem names with single quotes in case they have spaces.
            pvt.PivotSelect pvtFieldToFormat.Name & "['" & pvtItem.Name & "';Data;Total]", xlDataOnly
            'Call routine that does the formatting
            FormatRange Selection
        End If
        On Error GoTo 0
    Next pvtItem
   
    If IgnoreSubtotals Then
        'Clear the FormatConditions from Row and Column fields
        For Each pvtField In pvt.PivotFields
            If pvtField.Orientation = xlRowField Or pvtField.Orientation = xlColumnField Then
                'I can't figure a test for whether the subtotals are visible
                'so just blindly firing away.
                On Error Resume Next
                .PivotSelect "'" & pvtField.Name & "'[All;Total]", xlDataOnly
                If Err.Number = 0 Then
                    Selection.FormatConditions.Delete
                End If
                On Error GoTo 0
            End If
        Next pvtField
        .PivotSelect "'Row Grand Total'", xlDataOnly
        Selection.FormatConditions.Delete
        .PivotSelect "'Column Grand Total'", xlDataOnly
        Selection.FormatConditions.Delete
    Else
    End If
End With

Application.ScreenUpdating = True
End Sub

The FormatRange routine is just Macro Recorder code generated by selecting part of the pivot table and applying a color scale. You can do the same thing for data bars or icons.

In the sample workbook, the code is triggered by a WorkSheet_Change event that fires whenever one of the three yellow data validation cells is changed.

Filter Pivot Tables Using Source Data Helper Columns

When working with pivot tables you often need to filter out certain items. You can of course do this directly in the fields’ filter dropdowns, and often that’s good enough. But if you change the filters repeatedly this can be tedious and error-prone. For this reason, and to make my workbooks more flexible and maintainable, I often add helper columns to the source data. This post explains three types of source data helper columns that I use to filter pivot tables.

The live workbook below contains a simple data set of All-Star baseball games, where they were held, and which league won. It also contains three helper columns, each using a different method to determine the rows included in the pivot table. All three techniques refer to tables that spell out the criteria for inclusion.


(You can switch tabs, edit cells and refresh pivot tables. Reloading this page reverts it to its starting state. Note the buttons for downloading or opening in a full web page.)

You can click into the formulas in the helper columns and see that they are referring to tables – a different one for each column. Each formula uses a COUNTIF or COUNTIFS function to determine if the venue for that row meets certain criteria.

When you click on the “pivot and helper tables” tab you’ll see the pivot table on the left and the three helper tables on the right. The pivot table has a report filter for each of the three helper columns. Note that the report filters, table headers and helper columns are color-coded to show which ones go together.

Okay, let’s look at the three methods in order.

Table Containing Only Values to Include

Back on the data tab, the helper column “Venue In Table” looks at the first table, the one titled “Venues to Include”. The formula is a simple one:

=COUNTIF(tblVenuesToInclude[Venues to Include],[@Venue])>0

It returns TRUE if the ballpark for that row is found in the table. Its report filter is already set to TRUE in the pivot table, so you can test it by adding or deleting a stadium name in the table, right-clicking the pivot table and clicking “refresh”.

Table With All Values and an “Include” column

The second helper column/table pair are very similar, but instead of a table listing only the baseball fields you want included, you list all of them and add another column that contains TRUE if the ballpark should be included. I might use this method if I had a table with all the venues that I was already using for another purpose:

=COUNTIFS(tblVenuesIncludeCol[Venue],[@Venue],tblVenuesIncludeCol[Include],TRUE)>0

The COUNTIFS formula checks both the Venue and the Include columns. (You can use a SUMPRODUCT formula if you’re using Excel 2003 or earlier). You can test this formula by changing its report filter to TRUE and then changing the values in the Include column of the 2nd table.

Table Containing Words to Look For

The final helper column is “Venue Word in Table”. It looks into the “Word to Find” table and uses a COUNTIF array formula that searches the venue’s name for words from the table. Changing the report filter to TRUE will find the Kingdome, Polo Grounds and any park whose name contains “field”.

Here’s the formula, entered with Ctrl-Shift-Enter:

{=MAX(COUNTIF([@Venue],"*" & tblWordToFind[Word to Find] & "*"))>0}

This formula takes advantage of the ability to use wildcards in COUNTIF functions, by putting asterisks before and after the table column reference. Being an array formula, it tests the venue name against each word in the “Word to Find” table. The 1934 data row returns TRUE because “Polo Grounds” contains the word “polo”, which is in the table.

helper 3 and table

If we use the F9 key to successively evaluate parts of the function it looks like this:

=MAX(COUNTIF([@Venue],"*" & tblWordToFind[Word to Find] & "*"))>0
=MAX(COUNTIF([@Venue],"*" & {"king";"polo";"field"} & "*"))>0
=MAX(COUNTIF("Polo Grounds","*" & {"king";"polo";"field"} & "*"))>0
=MAX({0;1;0})>0
=1>0
TRUE

One final note: In actual practice, I always put the helper tables on a separate sheet, not next to the pivot table as done here. Expanding pivot tables, among other things, makes this layout impractical in real use.

Unified Method of Pivot Table Formatting

In preparation for my big annual reporting push I’ve developed a (partial) Unified Method of Pivot Table Formatting. My motivation was to define a system that allows me to copy pivot tables as values while preserving the formatting, and that increases formatting flexibility. Simply stated the Unified Method is:

“Use Conditional Formatting for Everything, and Apply Every Conditional Format to the Entire Pivot Table.” *

That’s right. No built-in “PivotTable Styles,” no field-level conditional formats, and no more just selecting the whole table, drawing a border around it and hoping “Preserve cell formatting on update” works.

* Excel 2007 and later. Applies only to formula-based conditions, e.g., not to color scales. Other restrictions apply.

Formatted Pivot Table

Above is a section of a world population pivot table. It has the following conditional formats:

  • The header row is colored orange with a black border around each cell.
  • There’s a black border to the left and right of the table.
  • Subtotal rows are bold with a black border above and below but no interior border, and are the same color as the header row.
  • Detail row cells are surrounded by a light gray border.
  • There are no borders between columns A and B, as Column A is only one pixel wide and flops over into Column B, as with “Oceania Total.”
  • Country rows have alternate banding by country.
  • State/Province rows’ population number font is gray

That’s quite a list, I think you’ll agree. In the past I might have used regular formatting, pivot table styles and field-level conditional formatting. I’d like to avoid all of those approaches, for the following reasons:

Regular Formatting: By “regular formatting” I mean something like selecting the whole pivot table and applying an outside border. This requires the pivot table setting “Preserve cell formatting on update” to be turned on. I’ll admit I’ve never mastered the quirks of this setting, so I’d like to just avoid it.

I’ve already found things, like header row word-wrapping, that may make me relent on this one.

Built-in PivotTable Styles: I really don’t like the built-in pivot table styles, for a few reasons:

  • The text and cell colors are ugly to the point of unusability. They almost always need modification.
  • Modifying them is a pain. The names for pivot table parts are weird. For example, what’s a “First Row Stripe,” and how does “Column Subheading 2” compare to “Subtotal Column 2?” So I do a lot of guessing and backing out of the dialog to see if I guessed right. Very clunky.
  • Pivot Table Modify Style Dialog

  • Finally, if you copy the pivot as values these formats disappear, although John Walkenbach has a solution for that.

Field-level Conditional Formatting: The field-level conditional formatting that became available in Excel 2007, and that I discuss in Re-Apply Pivot Table Conditional Formatting, is certainly better than the pivot table styles. But, again, the formats disappear when you copy the pivot table as values. And you can only use them to format the value fields of a pivot table, so for something like alternate row banding that includes row labels you need to apply the rule twice.

THE “UNIFIED” APPROACH
So, instead of the approaches above, I apply every conditional format to the entire pivot table. I use the ModifyAppliesToRange method, as discussed in the post linked above, to re-apply conditional formatting to the entire pivot table when it’s refreshed. This keeps all the formatting intact when I copy the table as values. It also allows me to easily apply formatting to specific columns and rows.

Note that in the Extend Pivot Table Conditional Formatting Post I only dealt with the rows of the pivot table that had data. In the example file at the end of this post I’ve extended the code to include the entire pivot table.

Two Examples
Since I’m applying the conditional formatting to the whole pivot table, the conditions sometimes need to specify row or column numbers. For example, I only want to gray the text for State/Province rows in columns D and E. That condition looks like this:

=AND(COLUMN(A1)>=4,$C1<>"")

This simply says if column C is blank, gray the text from Column D to the right. I could also specify less than or equal to 5 (column E), but since the conditional formatting is limited to the pivot table that’s not necessary.

Another part that was fiddly is not showing borders between columns A and B. To do this requires two formulas, one to negate column A’s right border, another to blank out column B’s left border. Here’s the formula and setup for column A:

No Border Formatting

The order of the rules is very important with this and other conditions. These “no-border” formats need to be before the formats with the borders.

A Couple More Things

I found this post harder to write than most. Although I think this is an interesting and helpful approach, I don’t know how clear I’ve been. If you have any questions, let me know.

It’s worth restating that the Unified Method of Pivot Table Formatting really only works for Excel 2007 onwards. Earlier versions limit you to three conditional formats in a given cell. Also, it only works for formula-based conditional formatting, i.e., not for color scales, icons, etc.

You can download a workbook with the pivot table shown above. It also includes the code to extend the conditional formatting to the whole table after it’s refreshed.

Hide Pivot Table Single-Item Subtotals

This pivot table looks awkward. The countries without provinces have a lone detail line, followed by a subtotal line with the exact same information. You can fix this by collapsing the single-item rows one at a time, but that’s time-consuming, and boring. Wouldn’t it be much more fun to write some code to hide pivot table single-item subtotals?

Pivot with single item subtotals

A year or so ago I did just that. In reviewing it for this post I cleaned it up and learned a few things about where it works and where it doesn’t. When I run it the result looks like this, with the duplicated population counts nicely hidden:

Pivot without single item subtotals

The heart of the code is this simple routine. You pass it a single PivotField and it hides the details for any item in that field that contains just one row:

Sub ProcessPivotField(pvtField As Excel.PivotField)
Dim ptItem As Excel.PivotItem

For Each ptItem In pvtField.PivotItems
    If ptItem.RecordCount > 1 Then
        ptItem.ShowDetail = True
    Else
        ptItem.ShowDetail = False
    End If
Next ptItem
End Sub

In my first version of this code I used ptItem.DataRange.Rows.Count. This caused errors with hidden items, because their DataRange is Nothing. With ptItem.RecordCount it just sails on through.

The main procedure checks whether the cursor is in a pivot table and a few things like that. It then calls a function that returns only the visible pivot table row and column fields:

Function GetPivotFieldNames(pvtTable As Excel.PivotTable) As String()
Dim PivotFieldNames() As String
Dim pvtField As Excel.PivotField
Dim i As Long
Dim PivotFieldsCount As Long

PivotFieldsCount = 0
With pvtTable
    ReDim Preserve PivotFieldNames(1 To .PivotFields.Count)
    For i = LBound(PivotFieldNames) To UBound(PivotFieldNames)
        Set pvtField = .PivotFields(i)
        If pvtField.Orientation = xlColumnField Or _
           pvtField.Orientation = xlRowField Then
            PivotFieldsCount = PivotFieldsCount + 1
            PivotFieldNames(PivotFieldsCount) = pvtField.Name
        End If
    Next i
End With
ReDim Preserve PivotFieldNames(1 To PivotFieldsCount)
GetPivotFieldNames = PivotFieldNames
End Function

The returned pivot fields are passed to a userform not unlike this one, except that it allows you to pick multiple items. That way you can collapse more than one field at a time. (I don’t show the code here, but you can get it all from the download link at the end.)

The form looks like this:

Collapsing single-item rows works great for lists like this one of continents, countries and provinces, because if a country has no subdivisions there’s no further detail to show. It’s just Iceland.

Where it doesn’t make as much sense is with something like sales by year, month, week and date:

Sales by week pivot

Even if you had sales in only one week in February, you’ll probably call it “week 6”, or “February 12 to 19”, or something. But when you collapse February that detail gets hidden.

Even more limiting is that you can’t collapse February for one year and leave it expanded for another. At least, I can’t find any way, either in VBA or in Excel. You either show a total for all your Februaries, or for none. In the example above it would be nice to hide the February 2012 total, but show it for 2013. If anybody knows a way to do that, please let us know.

To fool around with this for yourself you can download a workbook with a couple of sample pivots and the Single-Item Subtotal hider.

NOTE: I noticed a ways into this post that the population data is old. I tried to find something more recent, but didn’t come up with anything that had the provinces/states data. But it was nicely packaged in an Access database.

Create Pivot Table Named Ranges

I need to calculate percentiles from subsets of data in a pivot table. In order to refer to pivot table fields, it sure would be nice if they had dynamic named ranges. So I wrote some code to create pivot table named ranges.

pivot table named range generator intellisense

Programming pivot tables is fun. The extensive object model is a VBA wonderland with treats around every turn. There are great web sites out there with excellent pivot table coding samples – Contextures leaps to mind. In terms of identifying PivotFields, DataFields and other pivot table ranges, Jon Peltier wrote a superb post in 2009 that’s still generating discussion.

My code is pretty simple. It cycles through the data fields, and any other visible fields, in the specified pivot table and adds a named range for each one to the pivot table’s worksheet:

Sub RefreshPivotNamedRanges(pvt As Excel.PivotTable)
Dim ws As Excel.Worksheet
Dim pvtField As Excel.PivotField
Dim FieldType As String

With pvt
    Set ws = .Parent
    ClearOldNames ws, pvt
    For Each pvtField In .DataFields
        AddNamedRange ws, pvt.Name, "Data", pvtField.SourceName, pvtField.DataRange.Address
    Next pvtField
    For Each pvtField In .PivotFields
        Select Case pvtField.Orientation
        Case xlHidden
            GoTo next_one
        Case xlPageField
            FieldType = "Page"
        Case xlDataField
            FieldType = "Data"
        Case xlRowField
            FieldType = "Row"
        Case xlColumnField
            FieldType = "Col"
        End Select
        AddNamedRange ws, pvt.Name, FieldType, pvtField.Name, pvtField.DataRange.Address
next_one:
    Next pvtField
End With
End Sub

The PivotField.Orientation property has five enumerated constants that tell you what type of field it is – xlDataField, xlRowField, etc. The For/Next loop skips over the ones that come up xlHidden and processes the rest. Strangely, even though there’s a xlDataField type, and even though I can refer to pvt.PivotFields(“Sum of Home Runs”), the data fields don’t actually show up when cycling through the PivotFields. Instead, to get those fields the code first cycles through the pivot table’s DataFields collection.

When calling the AddNamedRange routine for a DataField, the codes passes its SourceName, not the Name. So in this example, the new name will include “Home Runs,” not “Sum of Home Runs.” You may want to pass the Name instead.

This next routine does what it says and clears out the previous range names associated with the pivot table. It’s not fool-proof. For example, if the pivot table name was changed, it won’t find the range names. I should probably use the pivot table’s Tag property to store names that won’t get changed:

Sub ClearOldNames(ws As Excel.Worksheet, pvt As Excel.PivotTable)
Dim nm As Excel.Name

For Each nm In ws.Names
    If InStr(nm.Name, "!_" & pvt.Name) > 0 Then
        nm.Delete
    End If
Next nm
End Sub

The routine below adds the worksheet-level names to the pivot table’s sheet. It calls a function that replaces spaces and other characters that aren’t allowed in range names (code at the end of the post). It also adds a “_” at the beginning of the name to hopefully avoid illegal names like “A1”:

Sub AddNamedRange(ByRef ws As Excel.Worksheet, ByVal PivotName As String, ByVal FieldType As String, ByVal PivotFieldName As String, ByVal PivotFieldAddress As String)
Dim CleanedRangeName As String

CleanedRangeName = "_" & GetCleanedRangeName(PivotName & "_" & FieldType & "_" & PivotFieldName, "_")
ws.Names.Add Name:=CleanedRangeName, RefersTo:="=" & PivotFieldAddress & ""
End Sub

To automate this stuff, put the code in a regular module and call RefreshPivotNamedRanges from a PivotTableUpdate event. The names will be regenerated each time the pivot table is refreshed, either manually or when you drag a field, or however.

Create Pivot Table Named Ranges - Name Manager 1

So now my Percentile array formula can find the value for the selected year and percentile:

Here’s the code to get the legal range names. You’ll need to set a reference to Microsoft VBScript Regular Expressions (at least if you’re an early binder):

Function GetCleanedRangeName(RangeName As String, SpaceReplacement As String) As String
Dim NewName As String

'the "" character escapes the Regex "reserved" characters
'x22 is double-quote
NewName = Regex_Replace(RangeName, "[\\\^\|\(\)\[\]\$\{\}\-x22/`~!@#%&=;:<>]", "", False)
'get rid of multiple contiguous spaces
NewName = Application.WorksheetFunction.Trim(NewName)
'255 is the length limit for a legal name
NewName = Left(Replace(NewName, " ", SpaceReplacement), 255)
GetCleanedRangeName = NewName
End Function

Function Regex_Replace(OriginalString As String, Pattern As String, Replacement, varIgnoreCase As Boolean) As String
' Function matches pattern, returns true or false
' varIgnoreCase must be TRUE (match is case insensitive) or FALSE (match is case sensitive)
' Use this string to replace double-quoted substrings - """[^""\r\n]*"""
Dim objRegExp As VBScript_RegExp_55.RegExp

Set objRegExp = New VBScript_RegExp_55.RegExp
With objRegExp
    .Pattern = Pattern
    .IgnoreCase = varIgnoreCase
    .Global = True
End With
Regex_Replace = objRegExp.Replace(OriginalString, Replacement)
Set objRegExp = Nothing
End Function

This has undergone a massive .5 days of testing, so I can guarantee there’s glitches. But if you’d like to give it a spin, here you go. It’s an Excel 2007/10 file as earlier versions don’t support the “Repeat All Item Labels” pivot setting that I rely on for the Percentile array formula. Other than that, it works just as well in Excel 2003.

Data Normalizer

Sometimes I get data like this…

that needs to be like this…

The goal here is to roll up all the home runs into one, much longer, column. The data will then be pivot-worthy.

Generally, I need to keep one or more leftmost column headers, in this case “League” and “Year.” I need a new column to describe the rolled-up category (“Team”) and one for the data itself (“Home Runs”). I’ve written code a couple of times to handle specific cases and thought I’d try to generalize it. Here’s the result:

'Arguments
'List: The range to be normalized.
'RepeatingColsCount: The number of columns, starting with the leftmost,
'   whose headings remain the same.
'NormalizedColHeader: The column header for the rolled-up category.
'DataColHeader: The column header for the normalized data.
'NewWorkbook: Put the sheet with the data in a new workbook?
'
'NOTE: The data must be in a contiguous range and the
'rows that will be repeated must be to the left,
'with the rows to be normalized to the right.

Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
    NormalizedColHeader As String, DataColHeader As String, _
    Optional NewWorkbook As Boolean = False)

Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet

With List
    'If the normalized list won't fit, you must quit.
    If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
        MsgBox "The normalized list will be too many rows.", _
               vbExclamation + vbOKOnly, "Sorry"
        Exit Sub
    End If

    'You have the range to be normalized and the count of leftmost rows to be repeated.
    'This section uses those arguments to set the two ranges to parse
    'and the two corresponding arrays to fill
    FirstNormalizingCol = RepeatingColsCount + 1
    NormalizingColsCount = .Columns.Count - RepeatingColsCount
    Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
    Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
    NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
    ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
    ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
End With

'Fill in every i elements of the repeating array with the repeating row labels.
For i = 1 To NormalizedRowsCount Step NormalizingColsCount
    ListIndex = ListIndex + 1
    For j = 1 To RepeatingColsCount
        RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
    Next j
Next i

'We stepped over most rows above, so fill in other repeating array elements.
For i = 1 To NormalizedRowsCount
    For j = 1 To RepeatingColsCount
        If RepeatingList(i, j) = "" Then
            RepeatingList(i, j) = RepeatingList(i - 1, j)
        End If
    Next j
Next i

'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
With ColsToNormalize
    For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
        Next j
    Next i
End With

'Put the normal data in the same workbook, or a new one.
If NewWorkbook Then
    Set wbTarget = Workbooks.Add
    Set wsTarget = wbTarget.Worksheets(1)
Else
    Set wbSource = List.Parent.Parent
    With wbSource.Worksheets
        Set wsTarget = .Add(after:=.Item(.Count))
    End With
End If

With wsTarget
    'Put the data from the two arrays in the new worksheet.
    .Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
    .Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList
   
    'At this point there will be repeated header rows, so delete all but one.
    .Range("1:" & NormalizingColsCount - 1).EntireRow.Delete

    'Add the headers for the new label column and the data column.
    .Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
    .Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
End With
End Sub

You’d call it like this:

Sub TestIt()
NormalizeList ActiveSheet.UsedRange, 2, "Team", "Home Runs", False
End Sub

It runs pretty fast. The sample sheet above – 109 years of data by 16 teams – completes instantly. 3,000 rows completes in a couple of seconds.

If I also run the routine on some American League data and put all the new rows in one sheet (with the same column headers) I can generate a pivot table that looks like this, which I couldn’t have done with the original data:

You can download a zip file with a .xls workbook that contains the data and code. Just click on the “normalize” button.

A Flexible VBA Chooser Form

Fairly often in VBA code I need to offer the user a list and have them make a choice, like picking which open workbook to do something to. I created a function and a userform to handle these situations. (Around the house, I call the form “ChooserForm” but it’s given name is “frmChooser.”) The function takes an array of choices and a caption as its arguments. The function loads frmChooser and passes it the string array and the caption. When the user makes a choice and clicks OK the function returns the choice to the calling routine.

Let’s look at how it works, starting from the inside out (by which I mean with the userform):

The frmChooser UserForm

Private mboolClosedWithOk As Boolean
Private mChoiceList() As String

Public Property Let ChoiceList(PassedList() As String)
mChoiceList() = PassedList()
End Property

Private Sub UserForm_Activate()
With Me.cboChooser
    .List = mChoiceList()
    .ListIndex = 0
End With
End Sub

Public Property Get ChoiceValue() As String
ChoiceValue = Me.cboChooser.Value
End Property

Private Sub cmdOk_Click()
mboolClosedWithOk = True
Me.Hide
End Sub

Public Property Get ClosedWithOk() As Boolean
ClosedWithOk = mboolClosedWithOk
End Property

Private Sub cmdCancel_Click()
mboolClosedWithOk = False
Me.Hide
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'in case the user clicked the "X"
If CloseMode = vbFormControlMenu Then
    Cancel = True
    cmdCancel_Click
End If
End Sub

The form has three custom properties. The first, Let ChoiceList, assigns the array of choices to the form’s module-level variable, mChoiceList(). On form activation the combobox cboChooser’s list is filled with the mChoiceList array.

The second property, Get ChoiceValue, is the currently selected value of the combobox. The function will “get” this, after the OK button is clicked, to determine the user’s choice.

The third property, Get ClosedWithOk tells the calling function whether the user hit the OK button. If it’s True then the function will do its processing. If it’s false, then the user hit the Cancel button or the “X,” and we’ll skip the processing.

The Function code

Function GetChoiceFromChooserForm(strChoices() As String, strCaption As String) As String
Dim ufChooser As frmChooser
Dim strChoicesToPass() As String

'why is this necessary?
ReDim strChoicesToPass(LBound(strChoices) To UBound(strChoices))
strChoicesToPass() = strChoices()
Set ufChooser = New frmChooser
With ufChooser
    .Caption = strCaption
    .ChoiceList = strChoicesToPass
    .Show
    If .ClosedWithOk Then
        GetChoiceFromChooserForm = .ChoiceValue
    End If
    Unload ufChooser
End With
End Function

The function creates an instance of frmChooser, called “ufChooser,” passes the Caption and ChoiceList properties and shows the form. After the .Show command, processing passes into the form and the code shown in the previous section. Processing returns to the function when the form is hidden, by either the OK or Cancel button’s click event. The function then checks the form’s ClosedWithOK property. If it’s true the function returns the form’s ChoiceValue property – the value selected in the combobox – to the calling routine.

You may have noticed the question “why is this necessary?” I can’t just pass strChoices() straight into the frmChooser instance. It causes a runtime “internal error.” Instead I have to declare a second string array strChoicesToPass() and copy the first array to it. If anybody can explain why, please share! (I think I could pass a variant straight through, but I don’t.)

The general form of this function’s code, and that of the userform, is from the venerable Professional Excel Development.

Using the Function

Now that we’ve got the function and the form, let’s choose something! I’ve got some code below that lists all the visible fields in a pivot table. When one is picked, the data range for the field is highlighted, along with the source column in the table, and the fields source name is displayed:

Sub ShowPivotFieldInfo()
Dim pvt As Excel.PivotTable
Dim lo As Excel.ListObject
Dim StartingCell As Excel.Range
Dim i As Long
Dim PivotFieldNames() As String
Dim pvtField As Excel.PivotField
Dim ChosenName As String

Set pvt = ActiveSheet.PivotTables("pvtRecordTemps")
Set lo = ActiveSheet.ListObjects("tblRecordTemps")
Set StartingCell = ActiveCell
With pvt
    ReDim PivotFieldNames(1 To .VisibleFields.Count) As String
    For i = 1 To .VisibleFields.Count
        PivotFieldNames(i) = .VisibleFields(i).Name
    Next i
    ChosenName = GetChoiceFromChooserForm(PivotFieldNames, "Choose a Pivot Field")
    If ChosenName = vbNullString Then
        Exit Sub
    End If
    Set pvtField = .PivotFields(ChosenName)
    With pvtField
        Union(.DataRange, lo.ListColumns(.SourceName).DataBodyRange).Select
        MsgBox Title:=.SourceName, _
               Prompt:="The SourceName for " & ChosenName & " is:" & vbCrLf & vbCrLf & .SourceName
    End With
    StartingCell.Select
End With
End Sub

This type of code can be useful when the PivotField names have been changed drastically from their underlying SourceNames, especially if the SourceNames are cryptic, similar, and there’s lots of them. In the picture below the SourceNames in the table were “Field 1”, “Field 2”, etc., but were changed to meaningful names like “Continent” in the pivot table.

Here’s the sample workbook for your downloading pleasure.