Highlight Pivot Row Totals

[Tim879]

Hi,

I'm trying to write a macro to highlight the total rows in my pivot
tables. I have Office 03.


Does anyone know how I can determine what colums / rows the pivot
table occupies to so that I can apply the correct formatting? I have
some code that doesn't work too well (posted at the bottom)


The logic of the program I want to write is:


Get the range that the pivot table occupies (e.g. A3:F100) (referred
to below as Pivot Range)

For each cell in the Pivot Range (assuming that the loop will go
a3, b3, c3, d3....)

if the cell contains the word Total then
Format the row from the current cell to the last
column of the pivot table range a certain color
go to the next row


The only other thing worth noting is that I only want to highlight
from the column with the total to the end of the pivot, so if c3
contains a total then in the example above, c3 - f3 would be
highlighted.


My code so far:
Sub Help()
Dim pt As PivotTable

Set pt = ActiveCell.PivotTable

pt.TableRange2.Select 'this selects the range that the pivot
occupies

For Each Cell In Selection
Set x = Cell.Find("Total")

If x = "" Then
x = ""
Else
With Cell.Interior
.ColorIndex = 26
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

End If
Next
Exit Sub

 

[Debra Dalgleish]

You could use code similar to the following, to colour the row field
totals and the grand total.

'===============
Sub ColourRowTotals()

Dim pt As PivotTable
Dim pf As PivotField
Dim iColour As Integer

iColour = 35 'light green
Set pt = ActiveSheet.PivotTables(1)

For Each pf In pt.RowFields
On Error Resume Next
pt.PivotSelect pf.Name & "[All;Total]", xlDataAndLabel, True
With Selection.Interior
.ColorIndex = iColour
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next pf
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Interior.ColorIndex = iColour

End Sub
'===============

 

[Tim879]

This worked like a charm. I've spent so much time on it and was
getting so frustrated that I could not solve it.

thank you so much for your help.

You could use code similar to the following, to colour the row field
totals and the grand total.

'===============
Sub ColourRowTotals()

Dim pt As PivotTable
Dim pf As PivotField
Dim iColour As Integer

iColour = 35 'light green
Set pt = ActiveSheet.PivotTables(1)

For Each pf In pt.RowFields
On Error Resume Next
pt.PivotSelect pf.Name & "[All;Total]", xlDataAndLabel, True
With Selection.Interior
.ColorIndex = iColour
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next pf
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Interior.ColorIndex = iColour

End Sub
'===============

Hi,

I'm trying to write a macro to highlight the total rows in my pivot
tables. I have Office 03.

Does anyone know how I can determine what colums / rows the pivot
table occupies to so that I can apply the correct formatting? I have
some code that doesn't work too well (posted at the bottom)

The logic of the program I want to write is:

Get the range that the pivot table occupies (e.g. A3:F100) (referred
to below as Pivot Range)

For each cell in the Pivot Range (assuming that the loop will go
a3, b3, c3, d3....)

if the cell contains the word Total then
Format the row from the current cell to the last
column of the pivot table range a certain color
go to the next row

The only other thing worth noting is that I only want to highlight
from the column with the total to the end of the pivot, so if c3
contains a total then in the example above, c3 - f3 would be
highlighted.

My code so far:
Sub Help()
Dim pt As PivotTable

Set pt = ActiveCell.PivotTable

pt.TableRange2.Select 'this selects the range that the pivot
occupies

For Each Cell In Selection
Set x = Cell.Find("Total")

If x = "" Then
x = ""
Else
With Cell.Interior
.ColorIndex = 26
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

End If
Next
Exit Sub

 

[Debra Dalgleish]

You're welcome, and thanks for letting me know that it worked. It helped
that you clearly explained what you were trying to do, and showed the
code that you'd written.

This worked like a charm. I've spent so much time on it and was
getting so frustrated that I could not solve it.

thank you so much for your help.

You could use code similar to the following, to colour the row field
totals and the grand total.

'===============
Sub ColourRowTotals()

Dim pt As PivotTable
Dim pf As PivotField
Dim iColour As Integer

iColour = 35 'light green
Set pt = ActiveSheet.PivotTables(1)

For Each pf In pt.RowFields
On Error Resume Next
pt.PivotSelect pf.Name & "[All;Total]", xlDataAndLabel, True
With Selection.Interior
.ColorIndex = iColour
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next pf
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Interior.ColorIndex = iColour

End Sub
'===============

Hi,

I'm trying to write a macro to highlight the total rows in my pivot
tables. I have Office 03.

Does anyone know how I can determine what colums / rows the pivot
table occupies to so that I can apply the correct formatting? I have
some code that doesn't work too well (posted at the bottom)

The logic of the program I want to write is:

Get the range that the pivot table occupies (e.g. A3:F100) (referred
to below as Pivot Range)

For each cell in the Pivot Range (assuming that the loop will go
a3, b3, c3, d3....)

if the cell contains the word Total then
Format the row from the current cell to the last
column of the pivot table range a certain color
go to the next row

The only other thing worth noting is that I only want to highlight
from the column with the total to the end of the pivot, so if c3
contains a total then in the example above, c3 - f3 would be
highlighted.

My code so far:
Sub Help()
Dim pt As PivotTable

Set pt = ActiveCell.PivotTable

pt.TableRange2.Select 'this selects the range that the pivot
occupies

For Each Cell In Selection
Set x = Cell.Find("Total")

If x = "" Then
x = ""
Else
With Cell.Interior
.ColorIndex = 26
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

End If
Next
Exit Sub