Pivot Table Banded Columns by Label

[shepa006]

Is there a way to alternate the column color based on the column label in a pivot table? I have something that looks similar to what is shown below. What I want to do, in order to increase readability, is to alternate the column colors based on the category, I added the column color in {} below. The idea is similar to using banded columns but I don't want it to just alternate each column, I need it to logically alternate the color.


__________| Column Labels
__________| Category 1 {gray}___| Category 2 {blue}___| Category 3 {gray}
Row Labels | Qty | UnitPrice | Cost | Qty | UnitPrice | Cost | Qty | UnitPrice | Cost

 

[Worf]

Welcome to the Board

See if this example is useful:

Sub pivotfrm()
Dim pt As PivotTable, cr As Range, db As Range, c%
Set pt = ActiveSheet.PivotTables(1)
Set cr = pt.ColumnRange
Set db = pt.DataBodyRange
For c = 1 To cr.Columns.Count
    Select Case cr.Cells(1, c)
        Case "Jan"                                          ' column label
            With cr.Cells(1, c).Resize(db.Rows.Count).Interior
                .ThemeColor = xlThemeColorDark1             ' gray
                .TintAndShade = -0.3
            End With
        Case "Jul"
        With cr.Cells(1, c).Resize(db.Rows.Count).Interior
                .ThemeColor = xlThemeColorAccent1           ' blue
                .TintAndShade = 0.6
            End With
    End Select
Next
End Sub

 

[shepa006]

Thanks for the suggestion. Too bad Excel doesn't have a built in option for this, it seems really useful.
I modified the code a bit and came up with the code below. I haven't extensively tested it and I need to play with the colors so that they aren't so overwhelming but the idea seems to work.

Sub PtBandedColByLabel()    
    Dim pt As PivotTable, cr As Range, db As Range, c%
    Set pt = ActiveSheet.PivotTables(1)
    Set cr = pt.ColumnRange
    Set db = pt.DataBodyRange
    Dim rowCount As Integer
    rowCount = pt.TableRange1.Rows.Count 'count of all rows in the table
    
    Dim rowOffset As Integer '
    rowOffset = 2
    
    'cell values
    Dim prevValue As String
    Dim curValue As Variant
    'state is used for toggling between theme values
    Dim curState As Integer
    curState = 1
    
    'default values
    Dim themeColorDefault As Integer
    Dim tintAndShadeDefault As Double
    themeColorDefault = 1
    tintAndShadeDefault = -0.3
    'toggled values
    Dim themeColor As Integer
    Dim tintAndShade As Double
    themeColor = themeColorDefault
    tintAndShade = tintAndShadeDefault
    
    For c = 1 To pt.DataBodyRange.Columns.Count 'cr.Columns.Count
        'Value of the current cell
        curValue = cr.Cells(rowOffset, c)
        
        'Test that the cell is not empty and that the value is different than the previous value
        If IsEmpty(curValue) = False And curValue <> prevValue Then
            'Alternate the color theme
            If curState > 0 Then
                themeColor = 1
                tintAndShade = -0.3
            Else
                themeColor = 4
                tintAndShade = 0.6
            End If
            'Toggle the color theme indicator
            curState = -1 * curState
            
            'Store the current value as previous value so that it can be compared to the value of the next cell
            If IsNumeric(curValue) Then
                prevValue = Str(curValue)
            Else
                prevValue = curValue
            End If
        
        End If
        
        'Update the interior settings
        With cr.Cells(1, c).Resize(rowCount).Interior
            .themeColor = themeColor
            .tintAndShade = tintAndShade
        End With
        
    Next
End Sub