Re-setting column widths after a Pivot Table Refresh

[Gavona]

Prompted by a post in the Office Forum (thread68-1561519), I decided to create a general routine to apply to pivot tables that lose their formatting when refreshed. The code focusses on:
i) making sure that data columns are wide enough to display the contained data
ii) Wrapping text in the column headings
iii)Autofitting the rows containg the column headings

I have only tested it on one pivottable and in Excel 2003

Sub pvtColWidths()
Dim minWidth As Integer
Dim myCol As Range

Set pvtTable = ActiveSheet.PivotTables("PivotTable1")
minWidth = InputBox("Please set minimum width for columns", "Pivot Reformat by Gavin", 15)

'Autofit columns for data area to ensure data displays correctly

    pvtTable.PivotSelect "Data[All]", xlDataOnly, True
    Selection.Columns.AutoFit

'Loop through the ColumnFields setting columns to the minimum width _
otherwise columns with nil data may have an unuseable width _
wrap text fopr column headings and autofit these rowst
For Each pvtfield In pvtTable.ColumnFields
    pvtTable.PivotSelect pvtfield.Name & "[All]", xlLabelOnly, True
    For Each myCol In Selection.Columns
            If myCol.ColumnWidth < minWidth Then myCol.ColumnWidth = minWidth
    Next myCol
    With Selection
        .WrapText = True
        .Rows.AutoFit
    End With
Next pvtfield
        
End Sub

Gavin

 

[Gavona]

Improved version:

Option Explicit
Sub pvtColWidths2()
Dim minWidth As Integer
Dim myCol As Range
Dim pvtTable As PivotTable
Dim pvtField As PivotField

Set pvtTable = ActiveCell.PivotTable
minWidth = InputBox("Please set minimum width for columns", "Pivot Reformat by Gavin", 15)

'Autofit columns for data area to ensure data displays correctly _
increase to minimum width as necessary

    pvtTable.PivotSelect "Data[All]", xlDataOnly, True
    Selection.Columns.AutoFit
    For Each myCol In Selection.Columns
            If myCol.ColumnWidth < minWidth Then myCol.ColumnWidth = minWidth
    Next myCol

    pvtTable.PivotSelect "Data[All]", xlLabelOnly, True

'wrap text for column headings and autofit these rows

For Each pvtField In pvtTable.ColumnFields
    pvtTable.PivotSelect pvtField.Name & "[All]", xlLabelOnly, True
    With Selection
        .WrapText = True
        .Rows.AutoFit
    End With
    'Don 't forget Grand Totals
    '       "' Adjusted Base' 'Row Grand Total'",
    pvtTable.PivotSelect pvtField.Name & " 'Row Grand Total'", xlLabelOnly, True
    With Selection
        .WrapText = True
        .Rows.AutoFit
    End With
    
Next pvtField

End Sub

Gavin