A Neat Trick/Macro for More Readable Pivots

 
OK, you’ve been a good Power Pivot author and given your measures clearly descriptive names.

Your punishment is spending all day looking at pivots like this:

Your Pivot is Too Wide for the Screen

Hey, Where’s the Rest of My Information?
(Hint:  It’s in “Scrollsville.”)

Nice and Cleanly Readable Pivot

MUCH Better:  Last Two Measures Completely Visible, With Space to Spare!
(Assuming Vertical Space Isn’t a Problem, Of Course)

A Trick I “Harvested” From a Client

Awhile back I was working with a gentleman named Tom Phelan who repeatedly used a series of click mouse clicks to achieve the sort of layout pictured above.  After seeing him do that about ten times I asked him to slow down so I could see what the clicks were.

 

The steps are:

  1. Resize the worksheet columns that “contain” the measures to be a uniform width, like 125 pixels.
  2. Format the measure header cells to be Wrap Text, Center Align Vertical, and Center Align Horizontal

Just two logical steps really, but those take 5-10 clicks.

So I wrote/recorded a macro that will do it for me in 1 click Smile

The Macro

A Magic Button for Formatting Your Pivots

Just Click the Magic Button!
(For instructions on adding your macro as a magic button,
scroll to the end of this post)

(If you are new to macros don’t worry, they aren’t that bad – check out this article on Chandoo.org  for a quick intro.)

Here’s the macro code, with usual disclaimers that I am not a programmer – I am a butcher:

Sub ShrinkColumnsToReadable()
    Dim oPivot As PivotTable
    Set oPivot = ActiveCell.PivotTable
    Dim oColRange As Range
    Set oColRange = FindColumnLabelsRange(ActiveSheet.Name, oPivot.Name)
    oColRange.Columns.Select
   
    ‘Increase this number for wider columns, smaller for narrower
    Selection.ColumnWidth = 15
   
    oColRange.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    ‘Turn AutoFit Column Width on Update OFF
    oPivot.HasAutoFormat = False
   
End Sub

Function FindColumnLabelsRange(sSheet As String, sPivot As String) As Range
    Dim oSheet As Worksheet
    Dim oPivot As PivotTable
   
    Set oSheet = ActiveWorkbook.Sheets(sSheet)
    Set oPivot = oSheet.PivotTables(sPivot)
   
    Set FindColumnLabelsRange = oPivot.ColumnRange
End Function

So, paste that into your favorite workbook, or better yet, a “Personal Macros Workbook,” and you’re off to the races.

Add it to Quick Access!

Adding a Macro to Quick Access Toolbar

In Excel Options, Follow the Steps Above to Add the Macro to Quick Access Toolbar
(In Step 5 You Can set the Icon)

21 Responses to A Neat Trick/Macro for More Readable Pivots

  1. Mike Dietterick says:

    Good one! I’ve found myself doing this manually a number of times but not often enough to work my way thru a macro (also not an advanced coder).

    With a little addition to your code, you can have this prompt the user for input on the column width so you can easily adjust without changing the code:

    Sub ShrinkColumnsToReadable()
    Dim oPivot As PivotTable
    Set oPivot = ActiveCell.PivotTable
    Dim oColRange As Range
    Set oColRange = FindColumnLabelsRange(ActiveSheet.Name, oPivot.Name)
    oColRange.Columns.Select
    Dim sUserInput As String

    ‘Ask user how wide to make the columns
    sUserInput = InputBox(“Enter Column Width (1-255):”, “User Input for Column Width”)

    ‘test input before continuing to validate the input
    If Not (Len(sUserInput) > 0 And IsNumeric(sUserInput) And sUserInput 0) Then
    MsgBox “Input not valid, code aborted.”, vbCritical
    Exit Sub
    End If

    ‘Increase this number for wider columns, smaller for narrower
    Selection.ColumnWidth = sUserInput

    oColRange.Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With

    ‘Turn AutoFit Column Width on Update OFF
    oPivot.HasAutoFormat = False

    End Sub

    Function FindColumnLabelsRange(sSheet As String, sPivot As String) As Range
    Dim oSheet As Worksheet
    Dim oPivot As PivotTable

    Set oSheet = ActiveWorkbook.Sheets(sSheet)
    Set oPivot = oSheet.PivotTables(sPivot)

    Set FindColumnLabelsRange = oPivot.ColumnRange
    End Function

  2. Mike Dietterick says:

    (comment deleted by Rob – I updated your original comment to include the complete macro)

  3. powerpivotpro says:

    By the way folks my macro REQUIRES that you have a cell selected in the pivot you want to format.

    Doesn’t matter WHAT cell – it can be any cell – but just has to be a cell in the pivot.

    THEN run the macro.

    Can’t wait to try Mike’s “prompt for width version” above.

  4. Mike Dietterick says:

    For some reason the validation code shows up when I paste but disappears when I submit. Last try. It should be:

    If Not (Len(sUserInput) > 0 And
    IsNumeric(sUserInput) And
    sUserInput 0) Then
    MsgBox “Input not valid, code aborted.”, vbCritical
    Exit Sub
    End If

    • Mike Dietterick says:

      This still cut it off. That’s really weird because it isn’t cutting off everything, just pieces. So anyway, I lied, this is the last try…

      After the IsNumeric test, it should be….

      And sUserInput 0.

      • powerpivotpro says:

        Is it “less thans” that are getting removed?

      • Mike Dietterick says:

        For some reason it won’t let me enter sUserInput is greater than or equal to 255 and sUserInput less than 0 after the IsNumeric test. So not sure if you can go in and manually add that part, please do. Thanks!

        • Mike Dietterick says:

          Yes. Does it think they are html tags? And I’ve reversed it in my last comment. Should be less than or equal to 255 and greater than 0.

          • powerpivotpro says:

            Yep it is defense against HTML injection. Nearly 5 yrs of this problem – you’d think we’d have fixed this by now. Looking into fixes today. It’s time.

          • Mike Dietterick says:

            No worries! :)

  5. Thienen says:

    I do this by using a Custom Style. Works like a charm (ok, it does not take care of the column width but I think is more straight forward.

  6. gm says:

    And if you set that Custom Style as default for Book.xltx (default excel file) than you have everything sorted out :)

  7. Brad C says:

    I also don’t update columns widths based on changes. That’s built into the pivot table options.

    • powerpivotpro says:

      Yep, that’s in the macro as well. I just didn’t call it out in the post:

      ‘Turn AutoFit Column Width on Update OFF
      oPivot.HasAutoFormat = False

  8. @Mike,

    Good one. I frequently like to make all columns the same width. Here’s another option using the various Range Properties of the PivotTable

    Option Explicit

    Sub AdjustPivotTableColumnWidth()

    ‘Declare variables
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngForWidthAdj As Range
    Dim pt As PivotTable

    ‘Initialize
    Set wb = ThisWorkbook

    ‘Main body
    For Each ws In wb.Worksheets
    For Each pt In ws.PivotTables
    ‘Use one of the special ranges of the PivotTable for the range
    Set rngForWidthAdj = pt.DataBodyRange

    ‘From there, it is easy to use properties and methods of the Range Object to move around and resize as you like
    ‘Instad of using the DataBodyRange, I want to move up to the HeaderRow
    Set rngForWidthAdj = GetRangeFromRange(rng:=rngForWidthAdj)

    ‘Adjust Column Width
    Call AdjColumnWidth(rng:=rngForWidthAdj)
    Next pt
    Next ws

    ‘Tidy up
    Set wb = Nothing

    End Sub

    Private Function GetRangeFromRange(rng As Range) As Range

    ‘Declare variables
    Dim c As Long
    Dim rngNew As Range

    ‘Initialize
    With rng
    c = .Columns.Count
    End With

    ‘Resize the range
    Set rngNew = rng.Resize(1, c)

    ‘Move up one row
    Set rngNew = rng.Offset(-1, 0)

    ‘Pass the object to the function
    Set GetRangeFromRange = rngNew

    ‘Tidy up
    Set rngNew = Nothing

    End Function

    Private Sub AdjColumnWidth(rng As Range)

    rng.Columns.AutoFit

    End Sub

  9. Nick says:

    Brilliant post! I do this constantly, although rather than want my columns all the same width, I generally just make them 2 or 3 rows deep and then have the various widths that results in (so each column has a different width depending on length, but they all get condensed based on a uniform, increased row depth). This has the benefit of minimizing screen width, but at the cost of a less slick format which you achieve.

    I played around with the code to get something that works for this desire. It’s basically the same but with row height instead of column width, although there are a couple of additional lines of code at the end which AutoFit in order to get this result.

    Sub ShrinkColumnsToReadable2()
    Dim oPivot As PivotTable
    Set oPivot = ActiveCell.PivotTable
    Dim oColRange As Range
    Set oColRange = FindColumnLabelsRange(ActiveSheet.Name, oPivot.Name)
    oColRange.Columns.Select
    Dim sUserInput As String

    ‘ Ask user how high to make the rows – have found 55 is good for 3 rows deep and 35 good for 2 rows deep
    sUserInput = InputBox(“Enter Row Height (1-255):”, “User Input for Row Height”)

    ‘ test input before continuing to validate the input
    If Not (Len(sUserInput) > 0 And IsNumeric(sUserInput) 0) Then
    MsgBox “Input not valid, code aborted.”, vbCritical
    Exit Sub
    End If

    ‘ Increase this number for wider columns, smaller for narrower

    Selection.RowHeight = sUserInput

    oColRange.Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = True
    .ReadingOrder = xlContext
    .MergeCells = False
    End With

    Selection.ColumnWidth = 1
    Selection.EntireColumn.AutoFit

    ‘ Turn AutoFit Column Width on Update OFF
    oPivot.HasAutoFormat = False

    End Sub

    Function FindColumnLabelsRange(sSheet As String, sPivot As String) As Range
    Dim oSheet As Worksheet
    Dim oPivot As PivotTable

    Set oSheet = ActiveWorkbook.Sheets(sSheet)
    Set oPivot = oSheet.PivotTables(sPivot)

    Set FindColumnLabelsRange = oPivot.ColumnRange
    End Function

    Thanks again legends!

  10. Sven says:

    Hi. I have a general question about formatting column headings in Pivot Tables.

    One of my biggest frustrations with Pivot Tables is that very often (not every time though, and I can’t figure out why), after a refresh or a click on a slicer, the column heading loses its formatting.

    That is, if you had the column heading set as right justify and wrap, this gets lost and the formatting becomes, for instance, left justify and no wrap. Is there a better way to solve this?

    • Krissy says:

      Have you tried to do a right click on the pivot table, select “PivotTable Options” from the pop up menu, then check the “Preserve cell formatting on update” checkbox from the “Layout & Format” tab?

      • Sven says:

        Thanks Krissy. I should have mentioned this in the beginning, sorry. By default, this is always checked for me, ie it SHOULD preserve the layout but it does not. Well, in reality, it preserves SOME formatting but not all. When I uncheck this box, then everything goes back to “ugly” default / original formatting; when I check it and then work with the slicers, the column headings sometimes jump to left justify, other times stays right, other times it loses the “Wrap Text” settings, etc. I have no idea why it’s doing this, and it does this on lots of machines, and in lots of files.

Leave a Comment or Question