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.  Turns off 'Save Source Data with file' option.
'   6.  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
        .SaveData = 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.

18 Comments

  1. Terry says:

    Hi,
    What version of Excel is this for? I couldn’t get it to run in ’03

  2. Jeff Weir says:

    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.

  3. snb says:

    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
  4. Patrick says:

    Best. Comments. Ever!

  5. Jeff Weir says:

    @Patrick: Finally…someone who appreciates my comic genius. I was chortling to myself for hours over that Desk.Usedrange reference.

  6. Jon Peltier says:

    Jeff -
    I got a kick out of that one.
    In my case we’d need to expand it to Desk.UsedRange.AverageDepth or Desk.UsedRange.LayersDeep.

  7. Frank says:

    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.

  8. Jon Peltier says:

    I wonder if the problem with number formats in SNB’s code is the interchanging of NumberFormat and NumberFormatLocal.

  9. snb says:

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

  10. Jeff Weir says:

    @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:

     With Application
       .ScreenUpdating = True
       .EnableEvents = True
       .Calculation = xlAutomatic
     End With

    before this:

    With pt
       .ManualUpdate = False
       .TableRange2.Select
       .TableRange2.Cut
        End With

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

  11. Jeff Weir says:

    @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?

  12. Jon Peltier says:

    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?

  13. Jeff Weir says:

    Ah, I see the problem now. You can only get/set the numberformat on pivotfields that don’t contain text or are not based on columns with mixed data types (as per a previous post at http://dailydoseofexcel.com/archives/2013/11/09/a-date-with-pivotitems/) . Will amend code accordingly.

  14. Jeff Weir says:

    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.

  15. snb says:

    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
  16. snb says:

    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’. :) ;)

  17. Jeff Weir says:

    Hi snb. That last comment has me scratching my head.

  18. Jeff Weir says:

    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.

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: