CODEWITHSUNDEEP
vbaexcelpivot-table
PeterT
PeterT

Reputation: 8557

Pivot Table: Detect When Pivot Field is Collapsed

For my data shown in a pivot table, I have chosen to apply conditional formatting to certain portions of the data table to highlight values within certain ranges. It was interesting to figure out how to highlight the 2nd level row data differently from the subtotal data, but I was able to work it out. My VBA fires using the Worksheet_PivotTableUpdate event so that whenever the user changes the pivot table fields, the conditional formatting is updated appropriately.

Colorized Pivot Table

This method continues to work when some of the sections are collapsed:

Colorized Pivot Table Partially Collapsed

My run-time error occurs when all of the top level sections are collapsed, so that the second level row data (position=2) is not shown.

Colorized Pivot Table All Collapsed

I get the following error:

enter image description here

I've been looking for a way to detect if ALL of the second position row fields are collapsed/hidden/invisible/not-drilledTo in order to identify that condition and skip the formatting part. However, I've not discovered which method or property of a PivotField, PivotItem, or PivotTable will give me that information.

The event code attached directly to the worksheet is

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    ColorizeData
End Sub

So in a separate module, the code for ColorizeData is

Option Explicit

Sub ColorizeData()
    Dim staffingTable As PivotTable
    Dim data As Range
    Set staffingTable = ActiveSheet.PivotTables(PIVOT_TABLE_NAME)
    Set data = staffingTable.DataBodyRange
    '--- don't select the bottom TOTALS row, we don't want it colored
    Set data = data.Resize(data.rows.count - 1)

    '--- ALWAYS clear all the conditional formatting before adding
    '    or changing it. otherwise you end up with lots of repeated
    '    formats and conflicting rules
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.FormatConditions.Delete
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
    staffingTable.DataBodyRange.Cells.NumberFormat = "#0.00"
    staffingTable.ColumnRange.NumberFormat = "mmm-yyyy"

    '--- the cell linked to the checkbox on the pivot sheet is
    '    supposed to be covered (and hidden) by the checkbox itself
    If Not ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Range("D2") Then
        '--- we've already cleared it, so we're done
        Exit Sub
    End If

    '--- capture the active cell so we can re-select it after we're done
    Dim previouslySelected As Range
    Set previouslySelected = ActiveCell

    '--- colorizing will be based on the type of data being shown.
    '    Many times there will be multiple data sets shown as sums in
    '    the data area. the conditional formatting by FTEs only makes
    '    sense if we colorize the Resource or TaskName fields
    '    most of the other fields will be shown as summary lines
    '    (subtotals) so those will just get a simple and consistent
    '    color scheme

    Dim field As PivotField
    For Each field In staffingTable.PivotFields
        Select Case field.Caption
        Case "Project"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(47, 117, 181), RGB(255, 255, 255)
                End If
            End If
        Case "WorkCenter"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(155, 194, 230), RGB(0, 0, 0)
                End If
            End If
        Case "Resource"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
===> ERROR HERE-->  staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        Case "TaskName"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
                    staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        End Select
    Next field

    '--- re-select the original cell so it looks the same as before
    previouslySelected.Select
End Sub

The specific set up of the table is when the user selects the row data as

enter image description here

Just in case you're wondering, I've included the two private sub calls here for completeness sake:

Private Sub ColorizeDataRange(ByRef data As Range, _
                              ByRef interiorColor As Variant, _
                              ByRef fontColor As Variant)
    data.interior.Color = interiorColor
    data.Font.Color = fontColor
End Sub

Private Sub ColorizeConditionally(ByRef data As Range)
    '--- light green for part time FTEs
    Dim dataCondition As FormatCondition
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.1", _
                                                  Formula2:="=0.5")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.ThemeColor = xlThemeColorAccent6
        .interior.TintAndShade = 0.799981688894314
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- solid green for full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.51", _
                                                  Formula2:="=1.2")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .Font.Color = RGB(0, 0, 0)
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = 5296274
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- orange for slightly over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=1.2", _
                                                  Formula2:="=1.85")
    With dataCondition
        .Font.Color = RGB(0, 0, 0)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 192, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- red for way over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlGreater, _
                                                  Formula1:="=1.85")
    With dataCondition
        .Font.Color = RGB(255, 255, 255)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 0, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With
End Sub

EDIT: thanks to @ScottHoltzman, I incorporated his check with the logic below and arrived a solution

    Case "Resource"
        If field.Orientation = xlRowField Then
            If (field.Position = 2) And PivotItemsShown(staffingTable.PivotFields("Project")) Then
                staffingTable.PivotSelect field.Caption, xlDataOnly, True
                ColorizeConditionally Selection
            ElseIf field.Position = 1 Then
                staffingTable.PivotSelect field.Caption, xlFirstRow, True
                ColorizeConditionally Selection
            End If
        End If

Upvotes: 3

Views: 1945

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27269

Use the ShowDetail method of the PivotItems object. I wrapped into a function to make a cleaner integration into your code. All because you have to test each item of the field.

Tested code:

If field.Orientation = xlRowField Then
    If PivotItemsShown(field) Then
        If field.Position = 1 Then
            staffingTable.PivotSelect field.Caption, xlFirstRow, True
        Else
            staffingTable.PivotSelect field.Caption, xlDataOnly, True
        End If
        ColorizeConditionally Selection
    End If
End If

Function PivotItemShown(pf as PivotField) as Boolean

    Dim pi as PivotItem

    For each pi in pf.PivotItems
        If pi.ShowDetail Then 
            PivotItemsShown = True
            Exit For
        End If
    Next

End Function

UPDATE: Two hacks method below

Since you know that, in your example, cell A10 will be blank if all 3 Project are collapsed, you can check like this:

If Len(Range("A10") Then ... `skip this section

Or, if you may have dynamic project lists at any time use this:

For each rng in Range(Range("A6"),Range("A6").End(xlDown))
    If Instr(rng.Value,"Project") = 0 and rng.Value <> "Grand Total" Then 
        '.... select the row range as needed
        Exit For
    End If
Next

Upvotes: 1

Related Questions