Change Background Color on PivotTable subtotal row
' I'm using this code in "my" pivot table formating routines:
Sub Format_pivottable()
Dim R As Range
Dim i As Integer
Dim pt As PivotTable
Set R = Selection ' just for restoration at the end of the
formating
On Error Resume Next
Set pt = ActiveCell.PivotTable ' first will see whether there is
an active pivot table
If pt Is Nothing Then
Set pt = ActiveSheet.PivotTables(1) ' lets see whether there is
at least one pivot table on the sheet
If pt Is Nothing Then
MsgBox "Error: Can't find pivot table on the active sheet!"
Exit Sub
End If
End If
' ....
'....
'....
'......
If pt.RowFields.Count 1 Then
For i = pt.RowFields.Count - 1 To 1 Step -1
If pt.RowFields(i).Subtotals(1) = True Then
pt.PivotSelect "'" & pt.RowFields(i).Name &
"'[All;Total]", xlDataAndLabel, True
If pt.RowFields(i).Position = 1 Then
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 44
Else
Selection.Interior.ColorIndex = 6
End If
End If
Next i
End If
R.Select ' restore old cell selection
End Sub
|