Pivot Table Autoformat XL2003

[louww]

Can anyone please help with creating my own autoformat for pivot tables, or something similar in VBA that I can reuse for other tables?

[Bob Phillips]

Yes.

[louww]

Do you have any solutions available?

[Bob Phillips]

Oh, I thought you were just asking generally, and you would supply the details later. We don't mind-read!

[louww]

Sorry, from researching this its seems to be a common problem with no real solution. XL 2003 formats are unfortunately quite ugly, so I would like to create more appealing formats similar to 2007 autoformats, which will obviously be available for other pivot tables in 2003.

Any ideas where to start, or is there something available that I'm not aware of?

[Aflatoon]

You cannot create autoformats per se, you would have to use code to format the pivot tables. It is that part that you would need to elaborate on if you want code provided.

[louww]

The code I have found, I dont' know how to use or change to appear similar to the tables styles used in 2007:

Sub FormatPivotTableSections()
'Identify a cells function in a pivottable with
'9 xlPivotCellBlankCell A structural blank cell in the PivotTable.
'7 xlPivotCellCustomSubtotal A cell in the row or column area that
' is a custom subtotal.
'4 xlPivotCellDataField A data field label (not the Data button).
'8 xlPivotCellDataPivotField The Data button.
'3 xlPivotCellGrandTotal A cell in a row or column area which is
' a grand total.
'6 xlPivotCellPageFieldItem The cell that shows the selected item
' of a Page field.
'5 xlPivotCellPivotField The button for a field (not the Data button).
'1 xlPivotCellPivotItem A cell in the row or column area which is not
' a subtotal, grand total, custom subtotal, or blank line.
'2 xlPivotCellSubtotal A cell in the row or column area which is a
' subtotal.
'0 xlPivotCellValue Any cell in the data area (except a blank row).

'Select portions of the pivot table for formatting as follows
'Range("A3").PivotTable.RowRange.Select
'Range("A3").PivotTable.DataBodyRange.Select
'Range("A3").PivotTable.ColumnRange.Select
'Range("A3").PivotTable.DataLabelRange.Select
'Range("A3").PivotTable.PageRange.Select 'Only if there is a value in page range
'Range("A3").PivotTable.TableRange1.Select 'All but Page Range
'Range("A3").PivotTable.TableRange2.Select 'All
Dim lLastColumn As Long
Dim lLastRow As Long

Dim rngPivotTableRange As Range
Dim rngCell As Range
Dim rngIntersect As Range
Dim rngInPivotTable As Range

'Clear current Pivot Table formatting (assumes A3 is a pivot table cell)
Set rngPivotTableRange = Range("A3").PivotTable.TableRange1 'All but page range
rngPivotTableRange.Font.Bold = False
rngPivotTableRange.Interior.ColorIndex = xlNone
SetBorderWeight rngPivotTableRange, xlNone

lLastColumn = rngPivotTableRange.Column + rngPivotTableRange.Columns.Count - 1
lLastRow = rngPivotTableRange.Row + rngPivotTableRange.Rows.Count - 1

For Each rngCell In rngPivotTableRange

Set rngInPivotTable = Application.Intersect(Range("A3").PivotTable.TableRange1, Range(rngCell.Address))

If Not rngInPivotTable Is Nothing Then

Select Case rngCell.PivotCell.PivotCellType
Case 0
'Don't set color of any data cells
Case 1
rngCell.Interior.ColorIndex = 6 'Categories = Yellow
Set rngIntersect = Application.Intersect(Range("A3").PivotTable.ColumnRange, Range(rngCell.Address))
If Not rngIntersect Is Nothing Then
rngCell.Font.Bold = True
End If

Case 2
Cells(rngCell.Row, lLastColumn).Interior.ColorIndex = 34 'Total Numbers to Light Turquoise
SetBorderWeight Cells(rngCell.Row, lLastColumn), xlMedium
rngCell.Interior.ColorIndex = 5 'Total Labels to Blue
Case 3
rngCell.Interior.ColorIndex = 10 'Grand Total Labels = Green
Case 4
rngCell.Interior.ColorIndex = 39 'Data Field Label = Lavender
Case 5
rngCell.Interior.ColorIndex = 46 'Non-Data Field Label = Orange
Case 6
rngCell.Interior.ColorIndex = 7 'Page Field = Pink
Case 7
rngCell.Interior.ColorIndex = 15 'Custom Subtotal = Grey-25%
Case 8
rngCell.Interior.ColorIndex = 40 'Tan
Case 9
rngCell.Interior.ColorIndex = 35 'Structural blank = Light Green

End Select
End If

Next

Cells(lLastRow, lLastColumn).Interior.ColorIndex = 4 ' Grand Total = Bright Green
SetBorderWeight Cells(lLastRow, lLastColumn), xlThick

Set rngPivotTableRange = Nothing
Set rngIntersect = Nothing

End Sub
Sub SetBorderWeight(rngRange As Range, iWeight As Integer)
'xlHairline = 1
'xlMedium = -4138
'xlThin = 2
'xlThick = 4
'xlnone = -4142

On Error Resume Next
Select Case iWeight
Case Is = 1, 2, 4, -4138, -4142 'valid values
'Set Weight
rngRange.Borders(xlDiagonalDown).LineStyle = xlNone
rngRange.Borders(xlDiagonalUp).LineStyle = xlNone
If rngRange.Columns.Count > 1 Then
If iWeight = xlNone Then
rngRange.Borders(xlInsideVertical).LineStyle = xlNone
Else
With rngRange.Borders(xlInsideVertical)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
End If
End If
If rngRange.Rows.Count > 1 Then
If iWeight = xlNone Then
rngRange.Borders(xlInsideHorizontal).LineStyle = xlNone
Else
With rngRange.Borders(xlInsideHorizontal)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
End If
End If
If iWeight = xlNone Then
rngRange.Borders(xlEdgeLeft).LineStyle = xlNone
rngRange.Borders(xlEdgeTop).LineStyle = xlNone
rngRange.Borders(xlEdgeBottom).LineStyle = xlNone
rngRange.Borders(xlEdgeRight).LineStyle = xlNone
Else
With rngRange.Borders(xlEdgeLeft)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
With rngRange.Borders(xlEdgeTop)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
With rngRange.Borders(xlEdgeBottom)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
With rngRange.Borders(xlEdgeRight)
.Weight = iWeight
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
End If
Case Else
'Do nothing
End Select
On Error GoTo 0
End sub