Excel 2010 - Pivot Table Conditional Format

[geekette]

I have a pivot table that in an older version of excel I was able to apply some conditional formatting. I have now been upgraded to office 2010 and am finding that pivot tables no longer store the conditional formatting applied.

I've built a solution using vba - (which runs on the PivotTableUpdate), however it takes about a minute to run and am wondering if there is a smarter way to do this? The code and functions I am using are below. If there is any advice on how I can enhance this to make it smarter I would be so greatful :O)


Private Function FormatRedRow(RangeName As Range, rng As Range, OffsetRef As Integer, OffsetTotal As Integer)

'If the AWOL flag is = 1 then format the cell red
For Each RangeName In rng
If (RangeName.Offset(0, OffsetRef).Value = 1 And RangeName.Offset(0, OffsetTotal) > 0) Then
With RangeName.Interior
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
End With
End If
Next RangeName

End Function

Private Function FormatGreenRow(RangeName As Range, rng As Range, OffsetRef As Integer, OffsetTotal As Integer)

'If the comment is other than Blank and range name > 0 format the row green
For Each RangeName In rng
If (RangeName.Offset(0, OffsetRef).Value <> " (blank)" And RangeName.Offset(0, OffsetTotal) > 0) Then
With RangeName.Interior
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399975585192419
End With
End If
Next RangeName

End Function

Private Function FormatBlanks(RangeName As Range, rng As Range)

'if any " (Blank) " in column format the text white

For Each RangeName In rng
If RangeName.Value = " (blank)" Then
With RangeName.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
End If
Next RangeName

End Function

Private Function FormatRedAbsence(RangeName As Range, rng As Range, OffsetRef As Integer)

For Each RangeName In rng
If RangeName.Offset(0, OffsetRef).Value = "Absence Not Logged" Then
With RangeName.Interior
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
End With
End If
Next RangeName

End Function


Private Sub ConditionalFormat()

Dim StaffedTime As Range
Dim Lunch As Range
Dim TotalAbsence As Range
Dim MeasuredHours As Range
Dim Comment As Range
Dim All As Range



Application.ScreenUpdating = False

'First set all formatting to 0

Range("CondFmt_rng").Select

With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'Format Staffed Time Column
Call FormatRedRow(StaffedTime, Range("Summary_Staffed"), 6, -2)
Call FormatGreenRow(StaffedTime, Range("Summary_Staffed"), -1, -2)
Call FormatRedAbsence(StaffedTime, Range("Summary_Staffed"), -1)

'Format Lunch column
Call FormatRedRow(Lunch, Range("Summary_Lunch"), 5, -3)
Call FormatGreenRow(Lunch, Range("Summary_Lunch"), -2, -3)
Call FormatRedAbsence(Lunch, Range("Summary_Lunch"), -2)

'Format TotalAbsence column
Call FormatRedRow(TotalAbsence, Range("Summary_Absence"), 4, -4)
Call FormatGreenRow(TotalAbsence, Range("Summary_Absence"), -3, -4)
Call FormatRedAbsence(TotalAbsence, Range("Summary_Absence"), -3)

'Format MeasuredHours column
Call FormatRedRow(MeasuredHours, Range("Summary_Measured"), 3, -5)
Call FormatGreenRow(MeasuredHours, Range("Summary_Measured"), -4, -5)
Call FormatRedAbsence(MeasuredHours, Range("Summary_Measured"), -4)

'Format blanks as white so not visible
Call FormatBlanks(Comment, Range("Summary_Comment"))

Range("A1").Select

Application.ScreenUpdating = True

End Sub