Some Things I Learned Lately

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

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.

Determining if a Pivot Field Has Visible Subtotals

Determining if a Pivot Field Has Visible Subtotals

In my last post I talked about identifying pivot table’s Values field, if it had one. That function plays a part in this post, which is shows two functions for determining if a pivot field has visible subtotals. As with the last post, I didn’t find much about this on the web. I even asked my first Excel question on Stack Overflow. After a bunch of experimentation I came up with a function that seems to always work. And then, whaddaya know I came up with a better one. I use the second function in my improved per-item conditional formatting utility, which I will post about soon.

What Do I Mean by “Visible Subtotals?”

In the picture below the pivot table is set to show subtotals for every field. However subtotals are actually visible only for the Region field. There’s none for the Items field, which makes sense since Items is the rightmost field, and its subtotals would just be a repeat of the individual item values:

All Subtotals at Bottom

The VBA Subtotals Property Does Half the Job

The first thing you might try in VBA is checking the pivot fields Subtotals property. However below you can see that it returns True for both fields. The issue is the same as above: Subtotals are turned on but they don’t show for the rightmost field:

Subtotals in Immediate Window

My First Attempt

So, I wrote some code that:
1. Checks if a field’s subtotals are turned on. If not, the function returns False.
2. Checks if any fields with the same orientation as the field we’re checking is a Values field
3. Tests if the field we’re checking is in the last position for its orientation (including the Values field). If not, then subtotals are on and the function returns True.

Function PivotFieldSubtotalsVisible_OLD(pvtFieldToCheck As Excel.PivotField) As Boolean
Dim i As Long
Dim SubtotalsOn As Boolean
Dim pvt As Excel.PivotTable
Dim ValueField As Excel.PivotField
Dim FieldPosition As Long

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
   
   'Get the pivot tables ValuesField
  Set ValueField = GetValuesField(pvt)
   'The Value field is a column or row field,
  'but won't have subtotals
  If ValueField Is pvtFieldToCheck Then
      GoTo exit_point
   End If
   
   'There are 12 possible types of Subtotals (at least XL 2003 on)
  'If any of them are TRUE then Subtotals are on.
  For i = LBound(.Subtotals) To UBound(.Subtotals)
      If .Subtotals(i) = True Then
         SubtotalsOn = True
         Exit For
      End If
   Next i

   'No need to proceed if they aren't even on
  If Not SubtotalsOn Then
      GoTo exit_point
   End If
   
   FieldPosition = .Position
   'This is confusing, but
  'if the Values field's position is greater than the field-to-check's position
  'we want to ignore the Values field, as it won't affect the field-to_check's visibility
  If Not ValueField Is Nothing Then
      If ValueField.Orientation = .Orientation And ValueField.Position > FieldPosition Then
         FieldPosition = FieldPosition + 1
      End If
   End If
   'If the field-to-check isn't in the last position
  '(taking into account the Values field)
  'then it's Subtotals will be visible
  If (.Orientation = xlColumnField And pvt.ColumnFields.Count > FieldPosition) Or _
      (.Orientation = xlRowField And pvt.RowFields.Count > FieldPosition) Then
      PivotFieldSubtotalsVisible_OLD = True
   End If
End With

exit_point:
End Function

A Better Way – PivotCell to the Rescue

The above seems to work fine, but it’s got kind of a feel-your-way-in-the-dark aspect to it. I would much rather just have some code that examines the actual pivot table and figures out whether a given field is currently showing any subtotals. Happily, I have found a way to do this.

It’s based on the Range.PivotCell object and its PivofField and PivotCellType properties, all of which go back to Excel 2003, according to this MSDN page. They allow you to cycle through a pivot table’s cells checking for ones with a PivotCellType of xlPivotCellSubtotal (or xlPivotCellCustomSubtotal ) and, if so, checking what PivotField the subtotals belong to. I’ll discuss this some more after the VBA.

The Code

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

How it Works

The code above actually only checks the pivot table’s ColumnRange and RowRange. These ranges are highligthed in the picture below. The code checks this area for cells with a PivotCellType of subtotal or custom subtotal. There are 10 PivotCellTypes, nine of which can be found in the ColumnRange or RowRange areas (the data area of the pivot table consists just of the xlPivotCellValue type.

ColumnRange and RowRange

The picture below highlights the cells with a PivotCellType of either xlPivotCellSubtotal or xlPivotCellCustomSubtotal. The custom subtotals are ones such as Min, Max and Average. These can be set in the field options menu. If the code finds a cell whose PivotCell.PivotCellType property is one of these two it then checks the cell’s PivotCell.PivotField object for a match with the field passed to the function.

PivotCell Subtotal types

I Like PivotCells

I’ve used the Range.PivotTable object quite a bit over the years. But it’s just recently that I’ve delved into the Range.PivotCell property. Hopefully I’ve given you some ideas for how you could use it to poke around in pivot tables.

Have you used the Range.PivotCell property? If so, leave a comment (I also love comments, especially the ones that add to my knowledge and don’t require me to do anything but say “thanks”).

PivotItem.DataRange Off By One Row Bug

PivotItem.DataRange Off By One Row Bug

This week I ran into a pivot table VBA issue I’ve never noticed before. When a pivot table has more than one data field, referring to a PivotItem.DataRange returns a range one row down from where it should be. Below you can see that the PivotItem.DataRange address is one row off and that the selection is below the pivot table:

PivotIItem.DataRange Offby One

If the pivot table has only one data field, e.g., if I get rid of “Sum of Total” above, the issue goes away.

I found one reference to this by Macro Marc on SO, but nothing else on the web. It seems like it would be a well-known thing though, especially if it’s been around for a while.

I’m curious if anybody knows whether this has been reported as a bug. I noticed it on my home computer running Office 365 Pro Plus. I’d be interested to hear if it’s on other versions.

My Workaround

In my very limited testing it seems like there isn’t a similar issue for PivotFields. So one idea is to compare the first row of a pivot field against the first row of its first pivot item and use the difference, if any, to offset the PivotItem.DataRange back to where it should be. However, I’m not sure that my concept of “first” will always be the same as Excel’s. Anyways I’m using this function:

Function GetPivotItemOffsetBugCorrection(pvt As Excel.PivotTable) As Long
'Only occurs if the pivot table has more than one data field
If pvt.DataFields.Count = 1 Then
   Exit Function
End If

GetPivotItemOffsetBugCorrection = pvt.VisibleFields(1).DataRange.Row - _
    pvt.VisibleFields(1).VisibleItems(1).DataRange.Row
End Function

Then I use it like this in places where I refer to a pivot item’s data range:

Set pvt = pvtItem.Parent.Parent
PivotItemOffsetBugCorrection = GetPivotItemOffsetBugCorrection(pvt)
For Each cell In pvtItem.DataRange.Offset(PivotItemOffsetBugCorrection)

Yuck!

If you’ve got a good solution for dealing with this, or any info, please leave a comment.

Identify a Pivot Table’s Values Field

Identify Pivot Table Values Field

Over the next few posts I plan to delve into a couple of functions I’ve written to identify areas in a pivot table. I also want to do a quick post on a pivot quirk I noticed recently. I then plan to roll it up into a post on my new-and-improved per-pivot-item conditional formatting tool. It’s good to have plans, right? Anyways, let’s get started with a function to identify a pivot table’s Values field.

I deduced the following just by messing around – I couldn’t find anything on the web about identifying a Values field. If I got something wrong, or if you have a better way to do this, please leave a comment.

What is a Values Field?

The Values field is the one that appears when you have more than one data field. Its location in the Rows or Columns area of the pivot table dialogs controls the grouping of those data fields. In the following example, I’ve grouped the data area by data fields within years. In other words, the two summing data fields appear side-by-side for each year:

Values Field by years then values

In the next example I’ve dragged the Value field up and now the data area grouping is for years within data fields:

Values Field by values then years

Some pivot table layouts, such as the one below, don’t show the word “Values” anywhere in the pivot table, but it still shows in the pivot table dialog:

Values Field Column Labels

Like all pivot fields, the Values field can be renamed. Note that though I changed it to “Frodo” in the pivot table, it still says “Values” in the dialog:

Values Field by values called Frodo

Everything I’ve said about the Columns area of the pivot dialog applies to the Rows area. The Values field behaves the same way there.

Identifying the Values Field in VBA

EDIT:

In the comments below Petra identified a much faster way using PivotTable.DataPivotField. DataPivotField contains the Values field, whether or not it’s visible. So, If DataPivotField.Orientation <> 0 tests whether the Values field is present.

So, anyways, I wanted a VBA function that returns a pivot table’s Values field if it has one. When figuring out how to do this I asked myself:

Is the Values field a PivotTable.DataField or a PivotTable.ColumnField/RowField?

The answer is both, kind of. So, for instance, in the examples pictured above typing the following into the immediate window returns “Values”:

? ActiveCell.PivotTable.ColumnFields("Values").Name

And so does this:

? ActiveCell.PivotTable.DataFields("Values").Name

So it looks like the Values field is both a data and column (or row) field. To further confirm this, note that this statement returns True:

? ActiveCell.PivotTable.DataFields("Values").Orientation = xlColumnField

So, even though it’s both a Data and Column (or Row) field it looks like it’s a bit more of a Column field (I’m going to stop saying “or Row” now). This is backed up by the fact that you can’t refer to it’s Data personality using an index. In other words, the following returns an error:

? ActiveCell.PivotTable.DataFields(3).Name (1 and 2 return the two other data fields)

Furthermore, if you check the DataFields.Count for the example above the count is only two.

Cutting to the Chase

In addition to the above, I’ve got one more informational tidbit: if you change the name of the Values field to “Frodo,” both its Data and Column selves refer to themselves as “Frodo.” So even though, as we’ve seen above, the dialog box continues to use the word “Values” to refer to this field, ? ActiveCell.PivotTable.DataFields("Values").Name gets you a runtime error 1004.

This means that you can’t just refer to the values field using “Values” in either its DataField or ColumnField version. If you do and a user changes its name you’re out of luck.

Fortunately, this has an upside, and it’s not just that I have something to blog about. It means that a Values field name is the only field name in the pivot table that can be repeated for a Data field and a Column field. Usually two fields can’t have the same name. For example, in the examples above if you try to rename “Year” or “Values” to “Sum of Unit Cost” you’ll get a “Field name already exists” error. But in the case of a Values field both its Data and Columm/Row references will be the same name.

This means you can identify a pivot table’s Value field by finding a row or column field that has the same name as a data field. Cool, eh?

The Function

Function GetValueField(pvt As Excel.PivotTable) As Excel.PivotField
Dim pvtField As Excel.PivotField
Dim TestField As Excel.PivotField
Dim ValueField As Excel.PivotField
 
'If there's only one data field then there won't be a Values field
If pvt.DataFields.Count = 1 Then
    GoTo exit_point
End If
 
For Each pvtField In pvt.PivotFields
    On Error Resume Next
    'test each non-data field for a data field with a matching name
   Set TestField = pvt.DataFields(pvtField.Name)
    On Error GoTo 0
    If Not TestField Is Nothing Then
        'if there's a match then you've got the Values field
        Set ValueField = pvtField
        Exit For
    End If
Next pvtField
Set GetValueField = ValueField
 
exit_point:
End Function

Boom! Let me know if you’ve got a better way, anything to add, etc. And, as always, thanks for dropping by.

Force Userform Textbox Scrolling to Top

Force Userform Textbox Scrolling to Top

I use my Edit Table Query utility every day to easily modify and test SQL in Excel. The main textbox contains the SQL code, which often fills more than the textbox. The problem is when I click into the textbox it always scrolls to the bottom. Even though this has been happening for months this always catches me off guard. I’m surprised, then annoyed. I finally decided to take action, and came up with some code to force userform textbox scrolling to the top.

The Issue
Here’s an example of what I’m talking about. When I click the New Data button the textbox content looks good, in that the numbers start at one. But as soon as I click into it the content scrolls to the bottom. (To add to my annoyance, the scrollwheel doesn’t work in the textbox.)
textbox scrolling issue

My solutions uses the Textbox’s SelStart and SelLength properties. I set both to 0, meaning that the selection starts before the first character. That’s what the “Force Start at Top” checkbox in the form does. (Download below!)

However, when I added those two lines of code another issue appeared. There was no scrollbar. In fact in the animation above you can see that there’s no scrollbar until I click into the textbox. And below you can see that with the scrolling fix applied there is no scrollbar:

no scrollbar after fix

You can force the scrollbar to appear by arrowing down past the bottom of the visible content. An internet search came up with the solution of setting focus on the textbox. I do this before applying the SelStart/SelLength code. That’s what the “Make scrollbars visible” checkbox does:

textbox scrolling fixed

VBA
Here’s a basic subroutine that takes some text and a button object as parameters. It sets a textbox’s text, sets the focus on the textbox, sets the selection start to zero and sets the focus back to the calling button.

Sub FillTextboxText(TextboxText As String, CallingButton As MSForms.CommandButton)

Me.TextBox1.Text = TextboxText
Me.TextBox1.SetFocus
Me.TextBox1.SelStart = 0
Me.TextBox1.SelLength = 0
CallingButton.SetFocus
End Sub

Other Stuff

Note that the issue with the scrollbar not appearing only occurs once in the life in the userform. In other words, once it has appeared it will always appear. I think.

You might have noticed that the form also has a Same Data button, this button simply saves the textbox contents to a string variable and then set the textbox’s text to that variable. Oddly, when you do this and then click into the textbox no scrolling happens at all, even before the checkboxes are checked. To see this, leave the checkboxes unchecked, click Restart, then click New Data, then scroll halfway up and then click Same Data. There’s no scrolling, even though I’ve done almost the same thing as was done with the New Data button.

This all makes me wonder how MS programmed textbox behavior. It seems almost like it forces the textbox to the bottom to make the scrollbar appear, and that it somehow checks the contents before it changes the scrolling position.

Download

Here’s a workbook with the Userform shown in this post.

Pivot Table Pivot Chart Navigator

Pivot Table Pivot Chart Navigator

This post is about navigating between pivot tables and pivot charts. The sample workbook contains a Pivot Table and Pivot Chart Navigator userform that lists the workbook’s pivot tables and takes you to them or their associated charts. The workbook also adds buttons to the chart and pivot table right-click menus. These buttons take you to the associated pivot chart or table. I used Ribbon XML for this last part since later versions of Excel don’t allow modification of the chart context menus with VBA. The downloadable workbook can be easily converted to an addin.

pivot chart context menu

I used to eschew pivot charts as far too clunky. Recently though I was given a project that contained many pivot charts. It seemed that, unless I’d just gotten much less picky (not likely), pivot charts work much better than I remembered. This impression was confirmed in a Jon Peltier post, so I know it’s true.

Using XML to Add to Right-Click Menus

As mentioned above, I’ve added a “Go to Source Pivot” button at the bottom of the chart context menu. I’d never used Ribbon XML to make a right-click menu before. The XML part is straightforward.

To create the button I used the Custom UI Editor and added a ContextMenu section to the XML. I also used the Microsoft’s NameX addin to figure out the name that refers to the chart context menu (ContextMenuChartArea) The XML for the chart and pivot table context menus is below. All of this, including links to the Custom UI Editor and the NameX addin, is covered very nicely in this MSDN post.

Since I’m already forced to use XML to modify the chart context menu, I used it for the pivot table context menu too, even though it can still be modified with VBA:

<contextMenus>
    <contextMenu idMso="ContextMenuChartArea">
     <button id="cmdGoToSourcePivot" label="Go To Source Pivot"
        onAction="cmdGoToSourcePivot_onAction"
        getVisible = "cmdGoToSourcePivot_GetVisible"/>
    </contextMenu>
    <contextMenu idMso="ContextMenuPivotTable">
     <button id="cmdGoToPivotChart" label="Go To Pivot Chart"
        onAction="cmdGoToPivotChart_onAction" />
    </contextMenu>
</contextMenus>

VBA to Go To Source Pivot
The code to go to the source pivot is similar to that in my Finding a Pivot Chart’s Pivot Table post. It looks at the charts PivotLayout property, which only exists if a chart is based on a pivot table. I use this same property in the RibbonInvalidate method to only show the “Go To Pivot Table” button when the chart is a pivot chart. That’s one thing I like about programming the ribbon: the code to show or hide tabs, buttons and other controls is generally simpler than it is when using VBA.

VBA to Go To Pivot Chart
The code to go to a pivot table’s chart loops through all chart sheets and charts on worksheets looking for one whose source range is the pivot table’s range:

Function GetPivotChart(pvt As Excel.PivotTable) As Excel.Chart
Dim wbWithPivots As Excel.Workbook
Dim ws As Excel.Worksheet
Dim chtObject As Excel.ChartObject
Dim cht As Excel.Chart

Set wbWithPivots = pvt.Parent.Parent
For Each cht In wbWithPivots.Charts
    If Not cht.PivotLayout Is Nothing Then
        If cht.PivotLayout.PivotTable.TableRange1.Address(external:=True) = pvt.TableRange1.Address(external:=True) Then
            Set GetPivotChart = cht
            Exit Function
        End If
    End If
Next cht
For Each ws In wbWithPivots.Worksheets
    For Each chtObject In ws.ChartObjects
        Set cht = chtObject.Chart
        If Not cht.PivotLayout Is Nothing Then
            If cht.PivotLayout.PivotTable.TableRange1.Address(external:=True) = pvt.TableRange1.Address(external:=True) Then
                Set GetPivotChart = cht
                Exit Function
            End If
        End If
    Next chtObject
Next ws
End Function

PivotNavigator Form
The other element of the sample workbook is a simple-yet-powerful form that navigates through a workbook’s pivot tables and pivot charts.

pivot navigator form

The form opens up with a list of all the pivot tables in the active workbook. Selecting an item in the form list takes you to the selected pivot. Use the Ctrl key with the left and right arrows to toggle between a pivot and its associated chart.

The form is modeless and responds to selection changes in the workbook, updating the list selection when you click into a different pivot or chart. This functionality uses VBA from my last post, which raises an event every time any chart in a workbook is selected.

Download
The sample workbook has the modified right-click menus, the navigation form and a button in the Developer tab to start the form. There’s even instructions!

Track ActiveCell Movement Within Selection

Track ActiveCell Movement Within Selection

I searched the internet a bit before deciding that neither Excel or the forums have a way to track Activecell movement in a Selection. So, even though I don’t have the most pressing need for such an event, I spent several quality hours coding one.

The Issue
Here’s what I’m talking about. You can capture cell activation using Selection_Change code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Range("A2") = ActiveCell.Address
Me.Range("B2") = ActiveCell.Value
End Sub

Selection Change

But this doesn’t capture cell activation within a selection, the kind that happens when you select an area and then tab through it:

No ActiveCell Change

I noticed this while creating a little ActiveCell Viewer form. My solution is to capture TAB key presses using Application.OnKey. This is a little clunky in a couple of ways, but it seems to work.

My Solution
So my userform uses OnKey to capture the Tab press when a Selection has more than one cell. Now I know when the active cell is changing within a selection, so that’s good. The hard part is that, since I’ve killed the normal Tab behavior, I have to recreate it in VBA with code that moves the ActiveCell one cell forward. Before I can do that I need to define the active cell’s location in terms of the selection.

Basically, the code cycles through each cell in each Area of the Selection. The Areas cycle through in the order they were selected. Tab cycles through each cell of an Area from top to bottom, right to left no matter how you selected the Area.

A Little More About Areas
I do believe that areas are always rectangular. If you make a selection with the control key down, each down-drag-up of the mouse represents an area. I’ve delved into this area (hah) before in the SelectTracker post. As indicated there, if you hold down Ctrl and click a cell five times you get a Selection with five Areas. Interestingly, Excel 2016 gives the unsuspecting user a bit of a hint that this is happening by making the cell a little darker with each click:

darkening Selection

Back to the Coding Process

At first, as so often happens, the VBA seemed fairly simple:

  1. Find the ActiveCell’s position within the overall Selection by looping through its Areas and through each Area’s cells.
  2. Figure out what the next (or previous) cell would be, accounting for moving from one Area to the next and hopping to the beginning of the next Area or looping back to the beginning of the whole Selection.

Then I started thinking about Selections with multiple Areas that intersect the ActiveCell. To deal with this I did two things needed to make the tabbing flow smoothly through overlapping Areas.:

  1. Created a global variable to track which of these areas was selected by the last Tab press.
  2. Created a short routine to figure out the “most recent” Area that intersects the ActiveCell

The Code
Here’s the code that identifies the Activecell’s position within the Selection’s Areas and Cells:

Private Sub SelectNextCellInSelection()

'This sub is called when the Tab key is pressed.
'The point is to be able to capture Tab key presses
'that occur within a Selection, thereby capturing movement of the Activecell.
Dim SelectionCellIndex As Long
Dim SelectionCell As Excel.Range
Dim SelectionArea As Excel.Range

For Each SelectionArea In Selection.Areas
    SelectionCellIndex = 0
    'Mod lets us cycle to the Area after we reach the last one
   SelectionAreaIndex = (SelectionAreaIndex Mod Selection.Areas.Count) + 1
    For Each SelectionCell In Selection.Areas(SelectionAreaIndex).Cells
        SelectionCellIndex = SelectionCellIndex + 1
        If SelectionCell.Address = ActiveCell.Address Then
            GoTo SelectNext
        End If
    Next SelectionCell
Next SelectionArea

SelectNext:
'Cycle to the next cell. If we're in the last one, we'll cycle to first.
SelectionCellIndex = (SelectionCellIndex Mod Selection.Areas(SelectionAreaIndex).Cells.Count) + 1
'If we're in the first cell must have gone to the next Area.
If SelectionCellIndex = 1 Then
    SelectionAreaIndex = (SelectionAreaIndex Mod Selection.Areas.Count) + 1
End If

Selection.Areas(SelectionAreaIndex).Cells(SelectionCellIndex).Activate
'Because it will get incremented next time round
SelectionAreaIndex = SelectionAreaIndex - 1
End Sub

The code above uses the Mod function to cycle back to the beginning of the next Area or of the entire Selection.

The code to cycle backwards was surpisingly more difficult. Mod didn’t work in reverse, For/Next doesn’t work in reverse, and the beginning number is the last number of the previous Area changes (not 1). So although the logic was the same, the coding was much trickier.

Putting this in a UserForm had the additional complication that the procedures assigned to a key using OnKey have to reside in a regular module. So my code has two very short routines that poke a property in the UserForm, effectively passing the action back into the form as soon as possible.

I also learned VBA’s AppActivate command which shifts the focus from the form to Excel proper. I do that at the end of the forms Activate procedure, since it’s a Viewer after all and doesn’t need the focus.

The ActiveCell Viewer
You may be wondering why you even need an ActiveCell viewer. Well, you probably don’t. But if you did, it might be to see what’s in cells with big blobs of text, or ones that are in hidden columns or rows. And its ability to view cell contents using different format strings might also be nice:

Viewer in Action

Download
Download the sample workbook and try it yourself!

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).

Download
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
AND …

Alrighty then. Thanks for dropping by!