Filtering Pivot Table Value Fields

Filtering Pivot Table Value Fields

In the old days, before I knew better, when I needed to filter a pivot table Value field I’d do it by using by throwing an autofilter from the Data menu on it:

Pivot with Autofilter

It made me feel dirty but I didn’t know any other way to filter pivot table value fields. Clearly pivot tables provided no filter in the Values columns:

Pivot with no filter

And then one day I read this SuperUser answer by mtone and never looked back. If you don’t know how to apply a Value Filter to a non-Value pivot field I recommend reading it right now:

SuperUser Value Filter answer

Good wasn’t it? I started to write a post about this and realized this was the best explanation I’ve seen. I especially like that mtone explains how choosing different fields to apply the filter to will result in different levels of aggregation, and will change your results.

One Value Field Filtering Oddity

I was prompted to write this post after answering Bijan’s question on Stack Overflow. I quickly helped solve his problem but was perplexed because his original issue was that he was applying a value filter to the value field itself. As I said at the beginning, this isn’t possible. Turns out that’s not quite true. After an extended chat he showed me how he did it.

Before you can do this, you first need to use the field as a Row, Column or Report field. Simply dragging it to the Row area of the Show Filter dialog and then to the Values area will do the trick. Once you do so, you can click the down arrow next to the field name in the pivot’s Show Fields dialog:

show fields with dropdown

At that point you can pick the various Value filters.

value field Value Filters

As Bijan discovered though this doesn’t actually do anything. No filtering occurs (and if it did, it wouldn’t be an aggregate filter anyways). And when you drag the field back to a non-value position it, the filter that is, goes away. Weird and bug-like.

MenuRighter Update Finished

MenuRighter Update Finished

A year or so ago I posted about updating MenuRighter, my free add-in for customizing Excel’s right-click menus. It’s done! You can go to the MenuRighter page for a download link and instructions. Or read on for some examples of what MenuRighter can do.

MenuRigher Customization Examples
Below I’ve modified the Row menu, with the default Excel 2016 version on the left and the modified version on the right. Copy, Cut, Paste and a few other buttons were removed and Freeze Panes is added to the top:

MenuRighter sample Row before


Here’s the modified Row menu in use. Note that the button caption changes in context from “Freeze” to “Unfreeze”:

MenuRighter Row modification in action

Modified Cell Menu
Here’s my modified Cell right-click menu. It’s barely recognizable, so let me restate that this is the menu you get when you right-click in a cell. I’ve again deleted the Cut, Copy, Paste, Clear Contents and several other buttons. At the top I’ve added the menu for my personal addin, cleverly named “myBar.” Just one click added the whole structure to the Cell menu:

MenuRighter sample Cell

You can see that I’ve also added a whole bunch of filtering buttons. Two of the built-in ones are pulled up a level from the Cell>Filter menu, like “Filter by Selected Cell’s Value.” There’s also a couple for my own routines, like “Filter by All Selected Values.”

“Autofilter” is there so I can toggle filtering for whatever Table or range I’m in. (If you’re looking for this one, one its locations is Worksheet Menu Bar > Data > Filter > AutoFilter).

Two Other Examples

Here I’ve added a couple of my routines to the Ply menu. That’s the one you get by right-clicking a sheet tab:
MenuRighter sample Ply

And here’s the entire File menu added to the Cell menu. Everything at your fingertips!

Cell with File

Just kidding. I’d never do that.

New MenuRighter Page

Again, here’s the page with the download link and instructions for the new version. Please let me know what you think if you try it.

Editing Shape Points for No Good Reason

Editing Shape Points for No Good Reason

Over at Bacon Bits, Mike Alexander has a nice post out yesterday on editing shape points to create custom graphics. It shows how to use a shape’s Edit Points command to create interesting dashboard icons. I haven’t used Edit Points for years, but his post inspired me to fool around with them. I ended up with a bit of code for Editing Shape Points for No Good Reason.

In Mike’s post he shows how you can edit points to modify a half-circle into a more interesting shape. His edit of a half-circle looks something like this (only better):

semicircle to wavy

I thought that was pretty cool, so then I dragged the top below the bottom:

semicircle to wavy

That was fun. Now how about some facial reconstruction for Smiley?

smiley to pointy

At this point of course I had to learn how to program these edits in VBA. The result is code that randomly messes with the edit points, along with colors:

Pointless Point Editing Code

Sub EditPointMadness()
Dim shp As Shape
Dim shpNodes As ShapeNodes
Dim CenterX As Long
Dim CenterY As Long
Dim CurrXValue As Long
Dim CurrYValue As Long
Dim ws As Excel.Worksheet
Dim pointsArray As Variant
Const PointOffset As Long = 200

Set ws = ActiveSheet
If ws.Shapes.Count = 0 Then
    ws.Shapes.AddShape msoShapeSmileyFace, 300, 300, PointOffset, PointOffset
    Exit Sub
End If
Set shp = ws.Shapes(1)
CenterX = shp.Left + (shp.Width / 2)
CenterY = shp.Top + (shp.Height / 2)
Set shpNodes = shp.Nodes
With shpNodes
    .Insert WorksheetFunction.RandBetween(1, .Count), msoSegmentCurve, msoEditingAuto, _
        WorksheetFunction.RandBetween(CenterX - PointOffset, CenterX + PointOffset), _
        WorksheetFunction.RandBetween(CenterY - PointOffset, CenterY + PointOffset), _
        WorksheetFunction.RandBetween(CenterX - PointOffset, CenterX + PointOffset), _
        WorksheetFunction.RandBetween(CenterY - PointOffset, CenterY + PointOffset), _
        WorksheetFunction.RandBetween(CenterX - PointOffset, CenterX + PointOffset), _
        WorksheetFunction.RandBetween(CenterY - PointOffset, CenterY + PointOffset)
    If Timer Mod 2 = 0 Then
        pointsArray = .Item(WorksheetFunction.RandBetween(1, .Count)).Points
        CurrXValue = pointsArray(1, 1)
        CurrYValue = pointsArray(1, 2)
        .SetPosition WorksheetFunction.RandBetween(1, .Count), _
            CurrXValue + WorksheetFunction.RandBetween(-PointOffset, PointOffset), _
            CurrYValue + WorksheetFunction.RandBetween(-PointOffset, PointOffset)
        shp.Fill.ForeColor.RGB = WorksheetFunction.RandBetween(1, 10000000)
        shp.Line.ForeColor.RGB = WorksheetFunction.RandBetween(1, 10000000)
    End If
    If Timer Mod 5 = 0 Then
        .Delete WorksheetFunction.RandBetween(1, .Count)
    End If
End With
End Sub

Every time you run the code above it adds, deletes and/or modifies another point. After a couple of times you get what I like to call “Picasso Smiley”:

smiley picasso

A few more and Smiley is getting blown into the next dimension:

smiley in the next dimension

Hopefully the code above is pretty straightforward. It leaves a few of the settings unrandomized, chiefly whether the new node is straight, shaped or a corner.

One question. How to refresh Excel between shape format changes?
One version of this code had a loop that edited the points every half second. But try as I might I couldn’t get the screen to update and show those changes. The changes would only appear after the code was finished, making a loop pointless. If anybody knows how to do this, please let us know (thereby adding some useful content to this post).

Here’s a workbook with the the code and a couple of buttons to run it.

smiley edit points

Getting Pivot Table Value Field Characteristics

Getting Pivot Table Value Field Characteristics

This post is about a bit of code that answered somebody’s Stack Overflow question, was fun to write, and taught me a few more things about the pivot table object model, which is my favorite object model. So neat, so tidy, so logical – just like pivot tables themselves.

What, you ask, do I mean by Value Field Characteristics? I mean the page, row and column fields and items that the value field is summing, counting or otherwise valuing. So in the picture below the selected value field has three row items: one each for Continent, Country and State.

value field

The Code

Here’s the code to print that same information to the Immediate window. Like the Excel tooltip in the picture it also lists the Value field name, e.g., Sum of Population, and its source field, e.g., Population. (This can be handy when you’ve modified the value field name to something like else, like “Residents.”):

Sub GetValueFieldStuff()
Dim pvtCell As Excel.PivotCell
Dim pvtTable As Excel.PivotTable
Dim pvtField As Excel.PivotField
Dim pvtItem As Excel.PivotItem
Dim pvtParentField As Excel.PivotField
Dim i As Long

On Error Resume Next
Set pvtCell = ActiveCell.PivotCell
If Err.Number <> 0 Then
    MsgBox "The cursor needs to be in a pivot table"
    Exit Sub
End If
On Error GoTo 0

If pvtCell.PivotCellType <> xlPivotCellValue Then
    MsgBox "The cursor needs to be in a Value field cell"
    Exit Sub
End If

Set pvtTable = pvtCell.PivotTable
For Each pvtField In pvtTable.PageFields
    i = 0
    For Each pvtItem In pvtField.PivotItems
        If pvtItem.Visible Then
            i = i + 1
            Debug.Print "PageField " & pvtField.Name & " - Pivot Item " & i & " is " & pvtItem.Name
        End If
    Next pvtItem
Next pvtField

Debug.Print "Value Field Name is " & pvtCell.PivotField.Name
Debug.Print "Value Field Source is " & pvtCell.PivotField.SourceName

For i = 1 To pvtCell.RowItems.Count
    Set pvtParentField = pvtCell.RowItems(i).Parent
    Debug.Print "Row Item " & i & " is " & pvtCell.RowItems(i).Name & ". It's parent Row Field is: " & pvtParentField.Name
Next i

For i = 1 To pvtCell.ColumnItems.Count
    Set pvtParentField = pvtCell.ColumnItems(i).Parent
    Debug.Print "Column Item " & i & " is " & pvtCell.ColumnItems(i).Name; ". It's parent Column Field is: " & pvtParentField.Name
Next i
End Sub

Before answering this question I didn’t know about the PivotCell.RowItems and PivotCell.ColumnItems properties. They’re pretty cool.

The person who posted this on Stack Overflow was looking to create an “actual” drilldown, which I think meant using the output to write a SQL query. You could modify the output of this routine to do so, as in this pseudocode:

SELECT * FROM qryContinentCountryState
WHERE pvtParentItem.Name = pvtCell.RowItems(i).Name

Alrighty then. Thanks for dropping by!

Finding a Pivot Chart’s Pivot Table

Finding a Pivot Chart’s Pivot Table

I don’t work with pivot charts very much, but recently I got the job of modifying a dashboard that uses a mess of them. As part of the modification, I’m deleting some of the charts, which is leaving behind unneeded pivot tables – pivot tables with unhelpful names like “PivotTable17.” In order to work with all this I wrote a quick routine for finding a pivot chart’s pivot table.

Until today I was under the impression you could create a pivot chart without having a pivot table. I thought they were just a different kind of representation of what’s in a pivot cache and that, as is true with pivot tables, you could have several feeding directly off one pivot cache. That’s not true. Every pivot chart requires a separate pivot table.

This meant that when I started deleting some pivot charts from the workbook I wanted to reduce the workbook clutter by also deleting their pivot tables. The trick was to find them. At first I tried clicking the ribbon’s “Change Data Source” button, but that points at the data the pivot table/chart combo is based on, not at the pivot table the chart is based on. I found I could see the pivot table name and the sheet it’s on in the pivot chart’s “Select Data” dialog. But then I was still stuck trying to figure out which pivot was which. What a perfect excuse to write some VBA and poke into some previously unexplored object model crannies!

The code below cycles through each pivot chart in a workbook, selects its pivot table and displays a msgbox with info about the pivot table. (In actual practice I collected all the pivot table data and used that to delete any pivot tables that weren’t in the collection. No hand-deleting if I can help it!)

The Code

Sub GetPivotChartSources()
Dim ws As Excel.Worksheet
Dim chtObject As Excel.ChartObject
Dim cht As Excel.Chart
Dim pvt As Excel.PivotTable

For Each ws In ActiveWorkbook.Worksheets
    For Each chtObject In ws.ChartObjects
        Set cht = chtObject.Chart
        If Not cht.PivotLayout Is Nothing Then
            Set pvt = cht.PivotLayout.PivotTable
            'activate the sheet the pivot is on
            MsgBox pvt.Name & " is on " & pvt.Parent.Name & " using data from " & pvt.SourceData
        End If
    Next chtObject
Next ws
End Sub

ChartObjects, PivotLayouts and More

The code above cycles through each ChartObject, which is the container for a chart embedded in a worksheet, as opposed to being its own tab. What we’re really interested in is the ChartObject’s chart object (ha!) so I set a variable to that. Then the key is that pivot charts have a PivotLayout* object, which in turn contains the pivot table object. Once you’ve got that you can access all the usual pivot table properties like Name, SourceData and TableRange2, which is the range containing the entire pivot table including the page filters.

After getting rid of the unneeded pivot tables I went back and ran very similar code to rename them to something more meaningful. First I renamed the charts from “Chart 17”, etc., to something like “chtRegionalRetentionRate” and then substituted this line into the heart of the code above:

pvt.Name = Replace(chtObject.Name, "cht", "pvt")

When I looked around the web for code to do this kind of stuff I didn’t find anything, and had to discover the crucial PivotLayout object on my own. So, as we used to say in the newsgroups, “hth”.

MSDN Errata?
* It seems to me that this MSDN PivotLayout page is wrong, and that it treats the PivotLayout object like the PivotLayout.PivotTable object.

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.