On Jan 3, 11:30*pm, BRC wrote:
Hi Al
I am looking for a way to format (shade) a pivot table to make it
easier to read. *I would like to alternate the background color. * For
simplicity sake lets say the table has student name in col A and the
classes for that student in col B. *So student 1 (S1) might have three
classes so there would be three rows devoted to S1 but Student 1 only
occurs in col A for the first occurrence (class) then col A is blank
until the next student appears. There are actually about 12 columns of
data for each class .
The closest post I found relating to this was titled “Shading rows of
with similar data” which discussed using conditiional formatting to
accomplish something very similar to what I am trying to do *but I
tried and could not get the code to run. *That post used the code:
=MOD(SUMPRODUCT(($A$1:$A1<"")/(COUNTIF($A$1:$A1;$A$1:$A1)+($A$1:$A
$1="")))*,2) * But Excel 2010 had problems with this code and it would
not execute.
Any thoughts or direction on this would be greatly appreciated. Thanks
BRC

Try the subroutine below:

Sub GreenBarPivotTable()
'---Assign some color codes.
Const iClr1 = 6 'Yellow
Const iClr2 = 4 'Green

'---Defining some variables.
Dim iClr As Integer
Dim rEnd As Long
Dim cBeg As Integer
Dim cEnd As Integer
Dim rBegOfRng As Long
Dim rEndOfRng As Long
Dim rngToHiLite As Range
Dim cel As Range

'---Clear the slate of any color/shading.
Cells.Interior.ColorIndex = xlNone

'---Initialization of variables.
' In a pivot table, this assumption s/b OK.
cBeg = 1
' Last column of data.
cEnd = ActiveSheet.UsedRange.Columns.Count
' Find the bottom of the data block. Note the subtraction.
rEnd = Cells(Rows.Count, 1).End(xlUp).Row - 1
' Assign color code.
iClr = iClr1
' Begin the process with the very last cell (just above Grand
Total).
' The variable "cel" here is the subtotal cell for each item.
Set cel = Cells(rEnd, cBeg)

'---Cycle through the data to highlight each block.
Do
' Assuming each item has its own subtotal,
' the bottom of each range to be highlighted
' is one line above this subtotal row.
rEndOfRng = cel.Row - 1
' The beginning of the range is determined
' using the equivalent of CTRL+UPPARROW.
rBegOfRng = cel.End(xlUp).Row

' Define the range to be highlighted.
Set rngToHiLite = Range(Cells(rBegOfRng, cBeg),
Cells(rEndOfRng, cEnd))
' Shade the relevant range.
rngToHiLite.Interior.ColorIndex = iClr

' Toggle the color code.
If iClr = iClr1 Then
iClr = iClr2
Else
iClr = iClr1
End If

' Redefine the reference cell to be the next item above.
Set cel = cel.End(xlUp).Offset(-1, 0)
Loop Until Right(cel, 5) < "Total"

End Sub