Change Background Color on PivotTable subtotal row

[mark]

Hi.

I have a programmed pivot table, and I want to be able to change the color
on the subtotal row to gray.

It happens to be the 6th pivot item (I reference it more dynamically in the
code)...

I have:

'************
dim pvT as PivotTable
dim pvF as PivotField

set pvT = ActiveSheet.PivotTables(1)
set pvF = pvT.PivotFields(6)
'*************

If I wanted to change the displayed wording on that subtotal line from the
default, I could put in something like:

pvF.SubtotalName = "Howard the Duck"

But, how can I change the background formatting?

if I knew which cell it is ahead of time, it could be like this:

Selection.Interior.ColorIndex = 15

Thanks.
Mark

 

[mark]

I found a way to do this, though I wouldn't consider it particularly
eloquent, in that it uses On Error GoTo..

If anyone knows of a better way, please do let me know.

But, this works:

'**************
Sub test()

Dim i As Integer

On Error GoTo check_next_cell:

For i = 1 To ActiveSheet.UsedRange.Rows.Count Step 1

If Cells(i, 1).PivotCell.PivotCellType = xlPivotCellSubtotal Then

Cells(i, 1).Interior.ColorIndex = 15

End If
check_next_cell:
Next i
On Error GoTo 0

End Sub

 

[minimaster]

' 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