This question is a follow-on to my previous question, asked and answered previously. (The code, with a three line modification and reposted here, is taken directly from that post in its entirety.)
After successfully getting my pivot table conditionally formatted, my users have noticed that any of the typical row indentations (for additional row fields) are missing. So when I have several fields selected as Rows, I see this:
Instead of this:
Missing the indentation makes it hard to read.
There are several things I've tried, including
Setting this same value using VBA, as in:
'--- restore the indentation levels (because all the formatting above wiped it out) staffingTable.CompactRowIndent = 4
And attempting to preserve the pivot table formatting:
staffingTable.PreserveFormatting = True
None of which achieve the desired indentation format.
I've included the code below in its entirety and would appreciate any insights to make this work if possible.
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", "TaskName"
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
' 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
'--- restore the indentation levels (because all the formatting above wiped it out)
staffingTable.CompactRowIndent = 4
staffingTable.PreserveFormatting = True
'--- re-select the original cell so it looks the same as before
previouslySelected.Select
End Sub
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
I don't entirely know why this happens, but it looks like when you clear the formatting on the worksheet, it is removing the indentation, but it is leaving the table in compact form. It seems that if you change the format of the table to something else and then change it back to compact form, it will fix the indentation.
Add these lines somewhere after you clear the formats in the worksheet:
ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
staffingTable.RowAxisLayout xlTabularRow
staffingTable.RowAxisLayout xlCompactRow
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.