Instant Pivot: Just Add Water

Ahem.

BEHOLD!


Sub InstantPivot()

' InstantPivot: Just Add Water
' Assign this to Ctrl + Shift + P or something like that.

' Description: * Turns selection into Excel ListObject
' * Makes a Pivottable out of it at the edge of the used range
' * Applies my preferred default settings
' * Selects the Pivot and cuts it, so that
' Dick Kusleika can then use arrow keys
' and Control + V to paste it where he wants
' without having to touch that unclean dusty rodent
' he keeps at the edge of his Desk.Usedrange
'

'Here's the settings it applies.
' 1. Changes the Report Layout to "Show in Tabular Form"
' 2. Turns on "Repeat All Item Labels" option
' 3. Turn off Subtotals
' 4. Turn off Grand Totals
' 5. De-selects the Row Headers option from the Design tab.
' 6. Turns off 'Autofit Column Width on Update'
' 7. Adopts the source formatting

' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz

' Name/Version: Date: Ini: Modification:
' InstantPivot 20140213 JSW Initial programming
' InstantPivotV2 20140216 JSW Added error handler and check for multiple cells
' InstantPivotV3 20140216 JSW Adopted SNB's approach of setting numberformat while turning subtotals off
' InstantPivotV4 20140216 JSW If run on existing pivot that is not based on ListObject, turns source into ListObject
' InstantPivotV5 20140216 JSW Now ignores Values fields and doesn't apply format if pf.function = xlCount
' InstantPivotV6 20140324 JSW Had accidentally left out With Application stuff at the start

' Inputs: None

' Outputs: PivotTable is formatted accordingly

Dim pc As PivotCache
Dim pf As PivotField
Dim pt As PivotTable
Dim lo As ListObject
Dim rng As Range
Dim strLabel As String
Dim strFormat As String
Dim i As Long
Dim wksSource As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With

On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo errhandler
If pt Is Nothing Then
Set lo = ActiveCell.ListObject
If lo Is Nothing Then Set lo = ActiveSheet.ListObjects.Add(xlSrcRange, Selection.CurrentRegion, , xlYes)
Set rng = Cells(ActiveSheet.UsedRange.Row, ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column + 1)
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo)
Set pt = pc.CreatePivotTable(TableDestination:=rng)
Else:
'Check if pt is based on a ListObject.
' * If so, set lo equal to that ListObject
' * If not, turn that source data into a ListObject
On Error Resume Next
Set lo = Range(pt.SourceData).ListObject
On Error GoTo errhandler
If lo Is Nothing Then
Set rng = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
Set wksSource = rng.Parent
Set lo = wksSource.ListObjects.Add(xlSrcRange, rng, , xlYes)
pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo.Name)
End If

End If

With pt
.ColumnGrand = False
.RowGrand = False
.RowAxisLayout xlTabularRow
.RepeatAllLabels xlRepeatLabels
.ShowTableStyleRowHeaders = False
.ShowDrillIndicators = False
.HasAutoFormat = False
.ManualUpdate = True
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = 1 To .PivotFields.Count - .DataFields.Count 'The .DataField.Count bit is just in case the pivot already exists
Set pf = .PivotFields(i)
With pf
If pf.Name <> "Values" Then
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
On Error Resume Next
.NumberFormat = lo.DataBodyRange.Cells(1, i).NumberFormat
On Error GoTo errhandler
End If
End With
Next i
End If
End With

' Get DataFields to match the formatting of the source field
' Note that this will only be neccessariy in the case that we're
' running this code on an existing pivot
On Error GoTo errhandler
If pt.DataFields.Count > 0 Then
For Each pf In pt.DataFields
If pf.Function <> xlCount Then pf.NumberFormat = pt.PivotFields(pf.SourceName).NumberFormat
' Do away with 'Sum of' or 'Count of' prefix etc if possible
On Error Resume Next
pf.Caption = pf.SourceName & " "
On Error GoTo errhandler
Next pf
End If

'This needs to go before the .Cut bit, otherwise the .Cut stack gets wiped
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With

With pt
.ManualUpdate = False
.TableRange2.Select
.TableRange2.Cut
End With
Err.Clear
errhandler:
If Err.Number > 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
MsgBox "Whoops, there was an error: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End If
End Sub

Begone, Carpal Tunnel Syndrome.

22 thoughts on “Instant Pivot: Just Add Water

  1. 2003? Ah, you Luddites. Always taking the wind out of my sail. ;-)

    Yeah, this is strictly for people that have paid Microsoft some money since 2007 or later. Sorry, Terry.

    Much of the point of this is that I ALWAYS turn my data sources into Excel Tables before I make PivotTables out of them, because then you never ever have to use that pesky ‘Change Data Source’ option to repoint your pivots ever again. This macro saves you having to do that. Plus it saves you having to do a whole bunch of other things like change a pivot from the terrible Excel 2007+ default settings into a format that is actually suitable for data analysis.

  2. Wouldn’t it be simpler to create a ‘template’ in which a querytable/listobject ann a pivottable based ont that listobject ? The only thing you would have to change is the querytable connection to another database.

    I tried to rewrite your code, assuming an already existing table; I wasn’t able to get nor write the property ‘numberformat’ of the pivotfields.
    I left the method I used to change that property commented out in the code.

    Sub InstantPivot()
    With ActiveWorkbook.PivotCaches.Create(xlDatabase, ListObjects(1))
    With .CreatePivotTable(Cells(1, ListObjects(1).ListColumns.Count + 2))
    .ColumnGrand = False
    .RowGrand = False
    .RowAxisLayout xlTabularRow
    .RepeatAllLabels xlRepeatLabels
    .ShowTableStyleRowHeaders = False
    .ShowDrillIndicators = False
    .HasAutoFormat = False
    .SaveData = False
    .ManualUpdate = False

    For j = 1 To .PivotFields.Count
    .PivotFields(j).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ' .PivotFields(j).NumberFormat = Range(.SourceData).Columns(j).Cells(1).NumberFormatLocal
    Next
    End With
    End With
    End Sub

  3. Jeff,
    if a blank range is selected, your code does neither create an empty table nor an associated Pivot.
    As SNB already mentioned there’s a problem with the NumberFormat property just using Mike Alexander’s code.

  4. No it isn’t. I tried numberformat first; when that didn’t work I switched to numberformatlocal with the same ‘result’.

  5. @Frank: Quite right. It used to, then I added something new which made it bomb out in that instance. Have amended, and added error handler.

    In regards to the error handler, I found I had to put this:

    before this:

    …because if I did it the other way around, the Cut command got wiped.

    And then I had to repeat it again within the ErrorHandler, but in a way so that it only gets triggered if there is an actual error.

  6. @snb and Frank: I’m not clear on the comment I wasn’t able to get nor write the property ‘numberformat’ of the pivotfields.

    The code seems to work fine with me. Can you elaborate about what you’re seeing?

  7. To get and set the pivot field’s number format, tested on a production pivot table:

    ?activesheet.pivottables(2).pivotfields(“Amount_”).NumberFormat
    #,##0.00
    ?activesheet.pivottables(2).pivotfields(“Amount_%”).NumberFormat
    0.0%

    activesheet.pivottables(2).pivotfields(“Amount_%”).NumberFormat=”General”
    activesheet.pivottables(2).pivotfields(“Amount_%”).NumberFormat=”0.0%”

    I would be careful about mixing any property and its local version unless you’re using the US-EN locality.

    By the way, what is
    Range(.SourceData).Columns(j).Cells(1).NumberFormatLocal

    Wouldn’t Columns(j).Cells(1) be the header of the jth column?

  8. snb: your idea of setting number formats at same time you’re turning off subtotals makes much more sense. That will teach me to plagiarize code from Bacon Bits without checking that it makes the most sense in the new context. Have amended my initial code, and have added an ON ERROR RESUME NEXT to get over the problem you were having.

  9. Although I seem to be too late; I will show you what I get. Jon’s idea was my first thought also; but I had to correct it.

    Sub InstantPivot()
    With ActiveWorkbook.PivotCaches.Create(xlDatabase, ListObjects(1))
    With .CreatePivotTable(Cells(1, ListObjects(1).ListColumns.Count + 2))
    .ColumnGrand = False
    .RowGrand = False
    .RowAxisLayout xlTabularRow
    .RepeatAllLabels xlRepeatLabels
    .ShowTableStyleRowHeaders = False
    .ShowDrillIndicators = False
    .HasAutoFormat = False
    .SaveData = False
    .ManualUpdate = False

    x2 = ActiveSheet.ListObjects(1).Range.Address ' $A$1:$I$108
    x3 = Range(.SourceData).Address ' $A$2:$I$108
    x4 = Range(.SourceData).Columns(1).Cells(1).Address ' $A$2
    x5 = Range(.SourceData).Columns(1).Cells(1).NumberFormat ' General

    x6 = .PivotFields.Count ' 9
    x7 = .PivotFields(1).DataType ' -4158 xlText
    x7 = .PivotFields(1).NumberFormat ' Run Time Error 1004; Application Defined or Object defined Error

    For j = 1 To .PivotFields.Count
    .PivotFields(j).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ' .PivotFields(j).NumberFormat = Range(.SourceData).Columns(j).Cells(1).NumberFormatLocal
    Next
    End With
    End With
    End Sub

  10. Hi @Jeff

    ‘Accidentally’ I stumbled upon a website named ‘HeavyDutyDecisions.co.nz’. It seems the owner must be a ‘dead poets society’ adept, although he adapted it to a ‘dead links society’. :) ;)

  11. I’ve updated the code so that if run on existing pivot that is not based on ListObject, the source gets turned into a ListObject, and the pivotcache gets amended to point at it. Again, this is purely to save me doing it manually.

  12. I use this all the time (orignal code, at the top), made one change, and would like help with another.

    Change I made: I didn’t like the look of my original source changing when it converts to a table, so Added

    .

    Change I’d like to make: sometimes my data source is based on a non-standard data table, like an old pastevalue pivot, so it might have one header name above all the rest of my headers. I’d like the option to exclude that from the table range so I don’t get a lot of “Column 1, Column 2, Column 3” headers, but haven’t figured out how to do that yet. Help would be appreciated.

  13. Hi Jomili. Good idea, and one I’ve been thinking about. I’m in the final stages of writing a book so am a bit busy now, but when that’s done I’ll amend the code accordingly and post back here.

  14. Nice work, Jeff! Gave it a spin in Excel 2011 on a Mac and it seems to run fine. My two cents on possible enhancements:

    1. Expose “settings” near the top, for easy customization
    2. New setting for Pivot Table style
    3. New setting for Table Style (per jomili above)

    I know you’re working on a book, so this is for later some day…

  15. Thanks Dave. A revised routine is going IN the book, so I’ll be sure to add these enhancements. And pretty soon I’ll be releasing a PivotTable Add-In that does this and a heck of a lot more.


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.