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:
Hey, Where’s the Rest of My Information?
(Hint: It’s in “Scrollsville.”)
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:
- Resize the worksheet columns that “contain” the measures to be a uniform width, like 125 pixels.
- 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
The Macro
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!
In Excel Options, Follow the Steps Above to Add the Macro to Quick Access Toolbar
(In Step 5 You Can set the Icon)