Deleting Pivot Table Drilldown Sheets

I tried to make drilling into pivot tables better once upon a time. I failed. Earlier this week, I read Debra’s blog post about showing details and deleting the sheets later. It got me thinking.

The problem I have is that her solution (and many others) rely on the Before_DoubleClick event. As you might imagine, I don’t double click to show pivot table details. I press the context menu key and choose Show Details from the menu. I need a different event or to capture that context menu item. I don’t think there’s any event that will allow me to identify new sheets only when they come from showing details of a pivot table. It doesn’t matter. The better answer is create my own shortcut.

In my Auto_Open and Auto_Close procedures in my PMW:

That’s Ctrl+Shift+D for the uninitiated. That will now run PTDrillDown

Lot’s of

in there. That’s the sign of really tight code, you know. This determines if the ActiveCell is in a pivot table by trying to set a PivotTable variable. If it’s in a pivot table, it next checks to see if it’s in the body (as opposed to row or column headers or filters). If it’s in the body, the code shows the detail, deletes any sheet with my special name, and names the resulting sheet with my special name. The special name lives in my MGlobals module.

And for the coup de grace, I have a class module that defines an Application variable WithEvents. I added this event procedure to it.

Whenever I switch off of the details sheet, it goes away. Now that’s keeping things tidy.

Listing New Shareholders

I have a list of several hundred stock transactions that consist of purchases, redemptions, transfers, and reissues.

  1. To get a list of new shareholders, I start by creating a pivot table from the data (Alt+N+V+Enter)

  2. Put the ShareholderName in Row Labels and the Date in Values

  3. Right click on any of the date numbers and choose Summarize Values By Min to get the earliest date for every shareholder.

  4. Right click on any of the dates (that probably don’t look like dates) and choose Value Field Settings. Then click on Number Format and format the field as a date.

  5. While you still have a date selected, choose Sort from the PivotTable Tools – Options Ribbon and sort largest to smallest

  6. Now you can copy the 10 new shareholder names from 2015.

Now try it yourself. You can download StockRegister.zip

Switching Aggregates in Pivot Fields

We’ve all been there. You create a pivot table, add your Values fields, and Excel thinks you want to Count them instead of Sum them just because you have a few blanks.

To fix it, you can click the yellow Count of Labor (for example), choose Value Field Settings, and change the aggregate. Or you can right click on any field and choose Summarize Values By and switch it to Sum. Both good options, but not good enough. I assigned Ctrl+Shft+A to this happy little customer and I’m toggling aggregates like crazy.

There’s probably a bug or two, but so far so good.

Learning from my Errors

There’s an annoying bug in VBA whereby if you’re trying to change the .visible status of a PivotItem, and if the PivotField had a number format set to General, and if you live in New Zealand, then you’re out of luck:

Unable to set visible property

If you live in the US however, you’ll be fine. No error for you.

Don’t believe me? Either change your Windows region to New Zealand and run this code, or swing down to my place and see it for your own eyes. Here’s where you’ll find me:

247 Rintoul Street

(Aside: Check out those awesome ocean views. Why if it wasn’t for that annoying continent-sized lump of Uranium and Gold Ore off to the West, we’d pretty much have 365 degree views of the entire Pacific. Fortunately they’re busy bulldozing that annoying outcrop and shipping it off to uranium reactors and jewelery stores across the globe. So we should have a completely unfettered view in 2 billion years or so).

Ok, so this issue isn’t just an issue for New Zealanders…it actually affects any place where you haven’t got your Windows ‘region’ set to US, with New Zealand being the only place where I’ve actually encountered such egocentric behavior to date. (I don’t get out much. Or rather, they don’t let me out much. Or rather they make it clear that I can go out, but I can’t come back in.)

According to IronyAaron in the comments at this thread:

When VBA recognizes the dates in the pivot cache, it reads the US version after parsing although the item is read as a locally formatted string. This therefore causes VBA to fail when recognizing Date variables.

Bummer! So write some code that filters PivotItems, and you might find that non-US users have issues, unless they change their regional settings in Windows to US beforehand. Good luck with that.

This nasty bug caused quite a bit of workaround in my FilterPivot routine. I used to do this horrible check on every single item in a potentially exhaustively long list of PivotItems in order to avoid the possibility of an error caused by this unlikely combination occurring:

If Not IsNumeric(Pi.Value) Then
'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
If IsDate(Pi.Value) Then
If Not bDateWarning Then
On Error GoTo ErrHandler
Err.Raise Number:=997, Description:="Can't filter dates"
On Error Resume Next
End If
Else: Pi.Visible = True
End If
Else: Pi.Visible = True
End If

But prompted by Jerry Sullivan’s comment I found that this was only an issue for non-US regional settings, and that this issue is now fixed in Excel 2013. (Thank you, Microsoft. But why the heck didn’t you tell me you’d fixed it?)

So now I can just do this:
pi.Visible = True

Or rather, I could just do that if everyone had Excel 2013. But they don’t. So I can’t. I still have to somehow catch this error. And as written above, my code rather inefficiently looks for possible trouble caused by a combination of things that is probably unlikely to occur. (I mean, how many people would dare to have their Windows region set to a non-US region while trying to filter a PivotItem that happens to be a date in a PivotField that happens to have a General format?) All that preemptive error checking can’t be good for business.

The error of my ways?

I’m sure you’ve already seen what looks to be like the error of my ways… why bother checking for errors just so I can avoid them? Why not embrase them: just plow ahead, and if the s#!t hits the fan, just deal with it. Something like this:

On Error Goto Errhandler
pi.Visible = True

'some other code

ErrHandler:
If Err.Number <> 0 Then
Select Case Err.Number
Case 1004 'Error likely due to bug outlined at http://dailydoseofexcel.com/archives/2013/11/09/a-date-with-pivotitems/
If Not IsNumeric(pi.Value) And IsDate(pi.Value) And pfOriginal.NumberFormat = "General" Then 'Yep, definately that 'Bug
'Note that we need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
i = i + 1
ReDim Preserve strDateItems(1 To i) 'Record the offending things to an array, so we can warn the user about the specific items
strDateItems(i) = pi.Value
End If
Case Else 'Some other error code here
End

Great: now that bug fix code in the Errhandler only gets fired up in the rare event that it is actually triggered. Sure beats neurotically checking each and every PivotItem to see if it might cause an issue.

Unfortunately in this particular case the code snippet in question sits within a larger loop, and the code immediately before needs to have an On Error Resume Next statement applied. That’s because in order to work out whether a PivotItem should be hidden, I’m adding it to a Dictionary object that also contains my desired filter terms, in order to see if it matches any of those filter terms. Which looks something like this:

On Error Resume Next
For Each pi In pfOriginal.PivotItems
dic.Add pi.Value, 1 'The 1 does nothing
If Err.Number <> 0 Then
pi.visible = true
...

So I’d need to put an On Error Goto Errhandler before the pi.Visible = True bit so that my bug fix code in Errhandler would get triggerred, and an On Error Resume Next bit after it, so that the Dictionary test occurs for the very next item. And those will get executed for every single PivotItem – which kind of defeats the efficiency ‘dividend’ of putting my handling code within Errhandler. So I figure I might as well just do this:


pi.Visible = True
If Err.Number = 1004 Then 'Error likely due to bug outlined at http://dailydoseofexcel.com/archives/2013/11/09/a-date-with-pivotitems/
If Not IsNumeric(pi.Value) And IsDate(pi.Value) And pfOriginal.NumberFormat = "General" Then 'Yep, definately that 'Bug
'Note that we need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
i = i + 1
ReDim Preserve strDateItems(1 To i) 'Record the offending things to an array, so we can warn the user about the specific items
strDateItems(i) = pi.Value
End If
End If

Two steps forward, one step backwards.

Maybe I shouldn’t have that On Error Resume Next in there in the first place…maybe I should catch errors from the Dictionary.add in Errhandler too, or even do the dictionary check in another procedure – something that Dick mentions here. Anyone got any advice here?

All I know is that this is a lot of work-around for a combination that is pretty unlikely, but potentially fatal to someone’s analysis.

UnPivot via SQL

Howdy folks. Jeff Pivot…err…Weir here again.

Recently Ken Puls did a handy post on how to unpivot data using PowerQuery. Jan Karel commented that you can do this using Multiple Consolidation Ranges. That’s true, but what I like about the PowerQuery approach is that you can translate the currently selected columns into attribute-value pairs, combined with the rest of the values in each row. That is, you can have multiple hierarchical columns down the left of your CrossTab as well as the column headers across the top that you want to amalgamate. Which is great if you have a crosstab like this:

CrossTab

Whereas the Multiple Consolidation trick only handles one column down the left out of the box.

Mike Alexander posted a great bacon-tasting morsel of a trick to get around that issue way back in 2009 when he used to blog. He simply concatenating all the non-column-oriented fields into one dimension field into one temporary column. Check out his post Transposing a Dataset with a PivotTable. But as commenter dermotb said…it’s like a magic spell that you have to write down somewhere, and try to find when you need it, because it’s complex. (I love Mike’s reply to that: Come on. Excel is full of magic syntax, mystical hot keys, and vba voodoo that requires some level of memorizing steps. That’s why I can make a living peddling “tips and tricks”.)

Another problem with the Multiple Consolidation trick is that you might well end up with more data than fits in your sheet, by the time you flatten it out. Especially in old Excel. Because the number of rows you end up with in a flat file is the number of rows you start off with times the number of columns that you’re going to amalgamate. So for say a time-series dataset that covers quite a few items and a reasonable period of time, you could be in trouble.

So a while ago I had a crack at writing a SQL routine that unpivots by doing lots of UNION ALL joins, and writes the data directly to a PivotTable. The UNION ALLs are required because the pidgin English version of SQL that Excel speaks (and Access too, I guess) doesn’t have a UNPIVOT command.

I struck a few hurdles along the way. For instance, it turns out that the Microsoft JET/ACE Database engine has a hard limit of 50 ‘UNION ALL’ clauses, which you will soon exceed if you have a big crosstab with multiple columns down the left. I found a great thread over at MrExcel at which Fazza overcame this hard limit by creating sub-blocks of UNION ALL statements, then stiching them all together with another UNION ALL. Another problem is that SQL didn’t like dates (and sometimes numbers) in the headers. So I turn them into text with an apostrophe.

And another thing I do is save a temp version of the file somewhere, and then query that temp version rather than querying the open workbook. Even though the Memory Leak issue that this avoids has been largely fixed in New Excel, I still found that querying the open book was causing grief occasionally.

Anyway, here’s the result. I’ve turned it into a function, and you can pre-specify inputs if you like. Otherwise you’ll be prompted for the following:

20131119_UnPivot_Select Entire Crosstab

20131119_UnPivot_Select Left Column Headers

20131119_UnPivot_Select Crosstab Column Headers

20131119_UnPivot_FieldName

…and then you’ll get a Pivot:

20131119_UnPivot_Output

Take it for a spin, let me know of any issues in the comments. Note that I’ve tried to code it to handle Excel 2003 and earlier, but I don’t have old Excel anymore so couldn’t test it. In fact, that’s why the TabularLayout sub is separate – I had to put it in a subroutine because if someone has ‘old’ Excel then the main function wouldn’t compile.

—Edit 11 March 2014—
I’ve updated the below code to incorporate snb’s approach using array manipulation from Unpivot Shootout where possible.

Cheers

Jeff


Function unpivot(Optional rngCrossTab As Range, _
Optional rngLeftHeaders As Range, _
Optional rngRightHeaders As Range, _
Optional strCrosstabName As String, _
Optional rngOutput As Range, _
Optional bSkipBlanks As Boolean = False) As Boolean

' Desc: Turns a crosstab file into a flatfile using array manipulation.
' If the resulting flat file will be too long to fit in the worksheet,
' the routine uses SQL and lots of 'UNION ALL' statements to do the
' equivalent of the 'UNPfaddIVOT' command in SQL Server (which is not available
' in Excel)and writes the result directly to a PivotTable

' Base code for the SQL UnPivot devived from from Fazza at MR EXCEL forum:
' http://www.mrexcel.com/forum/showthread.php?315768-Creating-a-pivot-table-with-multiple-sheets
' The Microsoft JET/ACE Database engine has a hard limit of 50 'UNION ALL' clauses, but Fazza's
' code gets around this by creating sublocks of up to 25 SELECT/UNION ALL statements, and
' then unioning these.

' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com

' Name/Version: Date: Ini: Modification:
' UnPivot V1 20131122 JSW Original Development

' Inputs: Range of the entile crosstab
' Range of columns down the left that WON'T be normalized
' Range of columns down the right that WILL be normalize
' String containing the name to give columns that will be normalized

' Outputs: A pivottable of the input data on a new worksheet.

' Example:

' It takes a crosstabulated table that looks like this:

' Country Sector 1990 1991 ... 2009
' =============================================================================
' Australia Energy 290,872 296,887 ... 417,355
' New Zealand Energy 23,915 25,738 ... 31,361
' United States Energy 5,254,607 5,357,253 ... 5,751,106
' Australia Manufacturing 35,648 35,207 ... 44,514
' New Zealand Manufacturing 4,389 4,845 ... 4,907
' United States Manufacturing 852,424 837,828 ... 735,902
' Australia Transport 62,121 61,504 ... 83,645
' New Zealand Transport 8,679 8,696 ... 13,783
' United States Transport 1,484,909 1,447,234 ... 1,722,501

' And it returns the same data in a recordset organised like this:

' Country Sector Year Value
' ====================================================
' Australia Energy 1990 290,872
' New Zealand Energy 1990 23,915
' United States Energy 1990 5,254,607
' Australia Manufacturing 1990 35,648
' New Zealand Manufacturing 1990 4,389
' United States Manufacturing 1990 852,424
' Australia Transport 1990 62,121
' New Zealand Transport 1990 8,679
' United States Transport 1990 1,484,909
' Australia Energy 1991 296,887
' New Zealand Energy 1991 25,738
' United States Energy 1991 5,357,253
' Australia Manufacturing 1991 35,207
' New Zealand Manufacturing 1991 4,845
' United States Manufacturing 1991 837,828
' Australia Transport 1991 61,504
' New Zealand Transport 1991 8,696
' United States Transport 1991 1,447,234
' ... ... ... ...
' ... ... ... ...
' ... ... ... ...
' Australia Energy 2009 417,355
' New Zealand Energy 2009 31,361
' United States Energy 2009 5,751,106
' Australia Manufacturing 2009 44,514
' New Zealand Manufacturing 2009 4,907
' United States Manufacturing 2009 735,902
' Australia Transport 2009 83,645
' New Zealand Transport 2009 13,783
' United States Transport 2009 1,722,501

Const lngMAX_UNIONS As Long = 25

Dim varSource As Variant
Dim varOutput As Variant
Dim lLeftColumns As Long
Dim lRightColumns As Long
Dim i As Long
Dim j As Long
Dim m As Long
Dim n As Long
Dim lOutputRows As Long
Dim arSQL() As String
Dim arTemp() As String
Dim sTempFilePath As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim oConn As Object
Dim sConnection As String
Dim wks As Worksheet
Dim wksNew As Worksheet
Dim cell As Range
Dim strLeftHeaders As String
Dim wksSource As Worksheet
Dim pt As PivotTable
Dim rngCurrentHeader As Range
Dim timetaken As Date
Dim strMsg As String
Dim varAnswer As Variant

Const Success As Boolean = True
Const Failure As Boolean = False

unpivot = Failure

'Identify where the ENTIRE crosstab table is
If rngCrossTab Is Nothing Then
Application.ScreenUpdating = True
On Error Resume Next
Set rngCrossTab = Application.InputBox( _
Title:="Please select the ENTIRE crosstab", _
prompt:="Please select the ENTIRE crosstab that you want to turn into a flat file", _
Type:=8, Default:=Selection.CurrentRegion.Address)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
rngCrossTab.Parent.Activate
rngCrossTab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If

'Identify range containing columns of interest running down the table
If rngLeftHeaders Is Nothing Then
On Error Resume Next
Set rngLeftHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the LEFT of the table that WON'T be aggregated", _
prompt:="Select the column HEADERS from the LEFT of the table that won't be aggregated", _
Default:=Selection.Address, Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngLeftHeaders = rngLeftHeaders.Resize(1, rngLeftHeaders.Columns.Count) 'just in case they selected the entire column
rngLeftHeaders.Cells(1, rngLeftHeaders.Columns.Count + 1).Select 'Returns them to the right of the range they just selected
End If

If rngRightHeaders Is Nothing Then
'Identify range containing data and cross-tab headers running across the table
On Error Resume Next
Set rngRightHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
prompt:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
Default:=Selection.Address, _
Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngRightHeaders = rngRightHeaders.Resize(1, rngRightHeaders.Columns.Count) 'just in case they selected the entire column
rngCrossTab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If

If strCrosstabName = "" Then
'Get the field name for the columns being consolidated e.g. 'Country' or 'Project'. note that reserved SQL words like 'Date' cannot be used
strCrosstabName = Application.InputBox( _
Title:="What name do you want to give the data field being aggregated?", _
prompt:="What name do you want to give the data field being aggregated? e.g. 'Date', 'Country', etc.", _
Default:="Date", _
Type:=2)
If strCrosstabName = "False" Then Err.Raise 999
End If

If rngOutput Is Nothing Then
'Identify range containing data and cross-tab headers running across the table
On Error Resume Next
Set rngOutput = Application.InputBox( _
Title:="Where do you want to output the data", _
prompt:="Select the top left cell where you want the transformed data to be output", _
Default:=Selection.Address, _
Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
End If

timetaken = Now()
Application.ScreenUpdating = False

'Work out if the worksheet has enough rows to fit a crosstab in
If Intersect(rngRightHeaders.EntireColumn, rngCrossTab).Cells.Count <= Columns(1).Rows.Count Then 'Resulting flat file will fit on the sheet, so use array manipulation. varSource = rngCrossTab lRightColumns = rngRightHeaders.Columns.Count lLeftColumns = UBound(varSource, 2) - lRightColumns If Not bSkipBlanks Then ReDim varOutput(1 To lRightColumns * (UBound(varSource) - 1), 1 To lLeftColumns + 2) Else lOutputRows = Application.WorksheetFunction.CountA(Intersect([appRightHeaders].EntireColumn, rngCrossTab)) - [appRightHeaders].Cells.Count ReDim varOutput(1 To lOutputRows, 1 To lLeftColumns + 2) End If If Not bSkipBlanks Then For j = 1 To UBound(varOutput) m = (j - 1) Mod (UBound(varSource) - 1) + 2 n = (j - 1) \ (UBound(varSource) - 1) + lLeftColumns + 1 varOutput(j, lLeftColumns + 1) = varSource(1, n) varOutput(j, lLeftColumns + 2) = varSource(m, n) For i = 1 To lLeftColumns varOutput(j, i) = varSource(m, i) Next i Next j Else lOutputRows = 1 For j = 1 To Intersect([appRightHeaders].EntireColumn, rngCrossTab).Cells.Count - [appRightHeaders].Cells.Count m = (j - 1) Mod (UBound(varSource) - 1) + 2 n = (j - 1) \ (UBound(varSource) - 1) + lLeftColumns + 1 If Not IsEmpty(varSource(m, n)) Then varOutput(lOutputRows, lLeftColumns + 1) = varSource(1, n) varOutput(lOutputRows, lLeftColumns + 2) = varSource(m, n) For i = 1 To lLeftColumns varOutput(lOutputRows, i) = varSource(m, i) Next i lOutputRows = lOutputRows + 1 End If Next j End If With rngOutput .Resize(, lLeftColumns).Value = rngLeftHeaders.Value .Offset(, lLeftColumns).Value = strCrosstabName .Offset(, lLeftColumns + 1).Value = "Quantity" .Offset(1, 0).Resize(UBound(varOutput), UBound(varOutput, 2)) = varOutput End With Else 'Resulting flat file will fit on the sheet, so use SQL and write result directly to a pivot strMsg = " I can't turn this crosstab into a flat file, because the crosstab is so large that" strMsg = strMsg & " the resulting flat file will be too big to fit in a worksheet. " strMsg = strMsg & vbNewLine & vbNewLine strMsg = strMsg & " However, I can still turn this information directly into a PivotTable if you want." strMsg = strMsg & " Note that this might take several minutes. Do you wish to proceed?" varAnswer = MsgBox(prompt:=strMsg, Buttons:=vbOK + vbCancel + vbCritical, Title:="Crosstab too large!") If varAnswer <> 6 Then Err.Raise 999

If ActiveWorkbook.Path <> "" Then 'can only proceed if the workbook has been saved somewhere
Set wksSource = rngLeftHeaders.Parent

'Build part of SQL Statement that deals with 'static' columns i.e. the ones down the left
For Each cell In rngLeftHeaders

'For some reason this approach doesn't like columns with numeric headers.
' My solution in the below line is to prefix any numeric characters with
' an apostrophe to render them non-numeric, and restore them back to numeric
' after the query has run

If IsNumeric(cell) Or IsDate(cell) Then cell.Value = "'" & cell.Value
strLeftHeaders = strLeftHeaders & "[" & cell.Value & "], "

Next cell

ReDim arTemp(1 To lngMAX_UNIONS) 'currently 25 as per declaration at top of module

ReDim arSQL(1 To (rngRightHeaders.Count - 1) \ lngMAX_UNIONS + 1)

For i = LBound(arSQL) To UBound(arSQL) - 1
For j = LBound(arTemp) To UBound(arTemp)
Set rngCurrentHeader = rngRightHeaders(1, (i - 1) * lngMAX_UNIONS + j)

arTemp(j) = "SELECT " & strLeftHeaders & "[" & rngCurrentHeader.Value & "] AS Total, '" & rngCurrentHeader.Value & "' AS [" & strCrosstabName & "] FROM [" & rngCurrentHeader.Parent.Name & "$" & Replace(rngCrossTab.Address, "$", "") & "]"
If IsNumeric(rngCurrentHeader) Or IsDate(rngCurrentHeader) Then rngCurrentHeader.Value = "'" & rngCurrentHeader.Value 'As per above, can't have numeric headers

Next j
arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
Next i

ReDim arTemp(1 To rngRightHeaders.Count - (i - 1) * lngMAX_UNIONS)
For j = LBound(arTemp) To UBound(arTemp)
Set rngCurrentHeader = rngRightHeaders(1, (i - 1) * lngMAX_UNIONS + j)
arTemp(j) = "SELECT " & strLeftHeaders & "[" & rngCurrentHeader.Value & "] AS Total, '" & rngCurrentHeader.Value & "' AS [" & strCrosstabName & "] FROM [" & rngCurrentHeader.Parent.Name & "$" & Replace(rngCrossTab.Address, "$", "") & "]"
If IsNumeric(rngCurrentHeader) Or IsDate(rngCurrentHeader) Then rngCurrentHeader.Value = "'" & rngCurrentHeader.Value 'As per above, can't have numeric headers

Next j
arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
'Debug.Print Join$(arSQL, vbCr & "UNION ALL" & vbCr)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' When using ADO with Excel data, there is a documented bug
' causing a memory leak unless the data is in a different
' workbook from the ADO workbook.
' http://support.microsoft.com/kb/319998
' So the work-around is to save a temp version somewhere else,
' then pull the data from the temp version, then delete the
' temp copy
sTempFilePath = ActiveWorkbook.Path
sTempFilePath = sTempFilePath & "\" & "TempFile_" & Format(Time(), "hhmmss") & ".xlsm"
ActiveWorkbook.SaveCopyAs sTempFilePath
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Application.Version >= 12 Then
'use ACE provider connection string
sConnection = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & sTempFilePath & ";Extended Properties=""Excel 12.0;"""
Else
'use JET provider connection string
sConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sTempFilePath & ";Extended Properties=""Excel 8.0;"""
End If

Set objRS = CreateObject("ADODB.Recordset")
Set oConn = CreateObject("ADODB.Connection")

' Open the ADO connection to our temp Excel workbook
oConn.Open sConnection

' Open the recordset as a result of executing the SQL query
objRS.Open Source:=Join$(arSQL, vbCr & "UNION ALL" & vbCr), ActiveConnection:=oConn, CursorType:=3 'adOpenStatic !!!NOTE!!! we have to use a numerical constant here, because as we are using late binding Excel doesn't have a clue what 'adOpenStatic' means

Set objPivotCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set objPivotCache.Recordset = objRS
Set objRS = Nothing

Set pt = objPivotCache.CreatePivotTable(TableDestination:=rngOutput)
Set objPivotCache = Nothing

'Turn any numerical headings back to numbers by effectively removing any apostrophes in front
For Each cell In rngLeftHeaders
If IsNumeric(cell) Or IsDate(cell) Then cell.Value = cell.Value
Next cell
For Each cell In rngRightHeaders
If IsNumeric(cell) Or IsDate(cell) Then cell.Value = cell.Value
Next cell

With pt
.ManualUpdate = True 'stops the pt refreshing while we make chages to it.
If Application.Version >= 14 Then TabularLayout pt

For Each cell In rngLeftHeaders
With .PivotFields(cell.Value)
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
Next cell

With .PivotFields(strCrosstabName)
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With

With .PivotFields("Total")
.Orientation = xlDataField
.Function = xlSum
End With
.ManualUpdate = False
End With
Else: MsgBox "You must first save the workbook for this code to work."
End If
End If

unpivot = Success

timetaken = timetaken - Now()
Debug.Print "UnPivot: " & Now() & " Time Taken: " & Format(timetaken, "HH:MM:SS")

errhandler:
If Err.Number <> 0 Then
Select Case Err.Number
Case 999: 'User pushed cancel.
Case Else: MsgBox "Whoops, there was an error: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Select
End If

Application.ScreenUpdating = True

End Function

Private Sub TabularLayout(pt As PivotTable)

With pt
.RepeatAllLabels xlRepeatLabels
.RowAxisLayout xlTabularRow
End With
End Sub

A date with PivotItems

Howdy, folks. Jeff here again. I’ve been sharpening up some code to manually filter a PivotField based on an external list in a range outside the PivotTable. It works blazingly fast. Unless there’s dates as well as non-dates in my PivotField. In which case it errors out.

Try this:
Put “Pivot” in A1
Put =TODAY() in A2
Put =VALUE(TODAY()) in A3

Now make a PivotTable out of that data.

Pivot_DDOE

Now put this code into the VBE and step through it:

Sub WhatThe()

Dim pf As PivotField
Set pf = ActiveSheet.PivotTables(1).PivotFields(1)
With pf
.NumberFormat = "d/mm/yyyy"
.PivotItems(1).Visible = True
.PivotItems(2).Visible = True
.NumberFormat = "General"
.PivotItems(1).Visible = True
.PivotItems(2).Visible = True
End With
End Sub

If the same thing happens to you as happens to me, you will either be speaking aloud the title of this routine, or you will be speaking aloud this:
Unable to get the PivotItems property of the PivotField class.

Go type these in the immediate pane:

? .PivotItems(1).name
41588
? .PivotItems(1).visible
True
? .PivotItems(2).name
10/11/2013
? .PivotItems(2).visible
Error 2042

What the…?

Now try these:

? ActiveSheet.PivotTables(1).PivotFields(1).numberformat
General
ActiveSheet.PivotTables(1).PivotFields(1).numberformat = "d/mm/yyyy"
? .PivotItems(2).name
10/11/2013
? .PivotItems(2).visible
True

So it seems can’t do certain stuff to a PivotItem if that PivotItem is a date but your PivotField number format is set to General.

That’s weird.

Equally weird, try this:
Select the PivotTable, and record a macro as you change it’s number format back to General.

Sub WhatThe_Part2()
ActiveSheet.PivotTables(“PivotTable14”).PivotFields(“Pivot”).Name = “General”
End Sub

What the …? Change the PivotField Number Format, and you get a macro that tells you that you changed the PivotField name!

So what happens if you run that macro? Well, it changes the name of the PivotField:
PivotField_20131110

It does nothing to the number format.

Strangely enough, I found some info on this problem at one of my most revisited blogposts that I had somehow missed: Jon Peltier’s Referencing Pivot Table Ranges in VBA

Stranger still, the answer was by Jon Peltier back in 2009 in relation to a question asked by….wait for it…me. Don’t know how I missed that. Must have been sleeping.
So I’ve come across this problem before, found an answer, completely forgotten about it, and then wasted 2 days trying to work out what the problem was, purely so I could Google my own answered question.

I’m going to read through all 238 ( and counting) comments in that thread and see what else Jon has told me over the years I’ve been learning VBA.
There’s also something on this at stackoverflow

Jeff

–edit–
Jon’s method was to loop through the pivot items, and compare the pivot item caption to what he was looking for:


For Each pi In pt.PivotFields("Order Month/Year").PivotItems
If pi.Caption = Format(TheDate, "m/dd/yyyy") Then
' or If DateValue(pi.Caption) = TheDate Then
'' FOUND IT
End If
Next

But now I know it’s probably easier just to change the format of the PivotField.

—edit 30 May 2014 —
Prompted by Jerry Sullivan’s comment I found that this was only an issue for non-US regional settings, and that this issue is now fixed in Excel 2013. (Thank you, Microsoft. But why the heck didn’t you tell me you’d fixed it?)

According to IronyAaron in the comments at this thread:

When VBA recognizes the dates in the pivot cache, it reads the US version after parsing although the item is read as a locally formatted string. This therefore causes VBA to fail when recognizing Date variables.

Bummer! So write some code that filters PivotItems, and you might find that non-US users have issues, unless they change their regional settings in Windows to US beforehand. Good luck with that.

— edit over —

PivotItems Are Wrong when Calculated Field Is Present

I have a procedure where I loop through a pivot table and create a general journal entry to be imported. I used the same procedure to create another journal entry, but with one change. For this new journal entry, I wanted to round all of the amounts to the nearest $10. They were estimates and I don’t like to post estimates to the penny because it implies a precision that just isn’t there.

To accomplish this seemingly simple task, I created a calculated field and adjusted the procedure to pull from that field. There was just one problem: my debits didn’t equal my credits! I know, I gasped too.

It turns out that looping through the pivot table with For Each pi In pf.PivotItems was starting on the row below the first pivot item and ending on the row below the last pivot item. It was offset one row.

I was puzzled for quite a while. The old procedure worked fine. Then it dawned on me that I had added a calculated field. When I removed the calculated field, it worked as expected. So I modified the procedure to do the rounding in VBA.

Next, I wanted to see if this was a fluke. I generated some sample data, namely First Name, Last Name, and City. Then I created a pivot table with City in the Row Labels section and Count of Last in the Value section. Finally, I created a calculated field expertly named Field1.

The calculated field is set to zero. It’s not really calculating anything. I added that to the Values section.

Now to test. I wrote some code to demonstrate that the PivotItems were pointing to the wrong cells. As part of my code, I wanted to remove the calculated field. I kept getting errors trying to remove the calculated field so I recorded a macro to see how it’s supposed to be done.

ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Field1").Orientation = xlHidden

Yep, that’s what I was trying to do. Only that doesn’t work. So I found a work around. I love finding bugs when I’m investigating other bugs.

Here’s the code:

Sub TestPivotItems()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

Set pt = ActiveCell.PivotTable
Set pf = pt.PivotFields("City")
Set pi = pf.PivotItems(1)

Debug.Print pi.LabelRange.Address, pi.LabelRange.Value
Debug.Print ActiveSheet.Cells.Find(pi.Value).Address, pi.Value
Debug.Print String(40, "-")

pt.PivotFields("Sum of Field1").DataRange.Cells(1).PivotItem.Visible = False

Debug.Print pi.LabelRange.Address, pi.LabelRange.Value
Debug.Print ActiveSheet.Cells.Find(pi.Value).Address, pi.Value

End Sub

And here’s the result:

Above the dashed line is what happens when calculated field is present. The PivotItem, which is in A4, shows A5 as its LabelRange. When I search for its Value, however, I get A4. When I removed the calculated field, it all works as expected.

Looping through PivotItems that Don’t Exist

I have some code that creates a journal entry import file based on a pivot table. It loops through the PivotItems and reads the DataRange.Value2 property. It’s nothing fancy or particularly complicated, but it gets the job done. Or it used to. You know that old problem with pivot items hanging around?. Yeah, that got me.

Unable to get the DataRange property of the PivotItem class

Once I realized that lCnt equaled 41 and I only had 40 GL Codes, I immediately knew the problem. But how to fix it. I checked the locals window to see if there was anything identifiable about the ghost pivot item.

It looks like when the RecordCount property is zero, it’s a pivot item that can be ignored. I considered code like this:

Set pt = wshExport.PivotTables(1)
pt.RefreshTable
wshExport.Range("A1").EntireColumn.AutoFit
Set pf = pt.PivotFields("GLAccount")

ReDim aOutput(1 To pf.PivotItems.Count + 1)

For Each pi In pf.PivotItems
If pi.RecordCount > 0 Then
lCnt = lCnt + 1
aRow(1) = "N"
aRow(2) = Format(pi.DataRange.Value2, "0.00")
aRow(3) = "N"
aRow(4) = "C"
aRow(5) = UCase(Replace$(wshExport.Range("rngDescription").Value, ",", "_"))
aRow(6) = pi.LabelRange.Value2
aRow(7) = Format(wshExport.Range("rngPeriod").Value, "00")
aRow(8) = "JE" & Format(wshExport.Range("rngJournal").Value, "00")
aRow(9) = wshExport.Range("rngSource").Text
aRow(10) = Format(wshExport.Range("rngTranDate").Value, "mm/dd/yyyy")
aRow(11) = Format(wshExport.Range("rngTranDate").Value, "dd")
aRow(12) = Format(wshExport.Range("rngTranDate").Value, "mm")
aRow(13) = Format(wshExport.Range("rngTranDate").Value, "yyyy")

aOutput(lCnt) = Join(aRow, ",")

dTotal = dTotal + pi.DataRange.Value
End If
Next pi

I also read Debra’s site on the matter and considering just setting the Retain Items to “None” at design time. The problem with that is that I may redo the pivot table or reuse the code on a different table and forget to set that property. I ended up setting that property in code. Instead of checking RecordCount in the loop, I just set the MissingItemsLimit property to xlMissingItemsNone before I refresh and it gets rid of any stray pivot items.

Set pt = wshExport.PivotTables(1)
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt.RefreshTable
wshExport.Range("A1").EntireColumn.AutoFit
Set pf = pt.PivotFields("GLAccount")

ReDim aOutput(1 To pf.PivotItems.Count + 1)