CODEWITHSUNDEEP
excelvba
Allwyn P
Allwyn P

Reputation: 43

Color Pivot Table data depending on column header compared to row data

I have a pivot tables that have no of days as columns and category as rows,

EDIT:- I want to highlight 4 conditions

  1. all Values that fall under the condition online and are equal to 2 days (in one color "Orange")
  2. all Values that fall under the condition online and are greater than 2 days (in one color "Red")
  3. all cells that are under any header greater than 5 days (in another color "Yellow")
  4. any time the headers are 5 days or more, then the headers themselves are highlighted in "Yellow"

PFB image for table

thus I want to highlight cell values based on Column values(condition based greater than 6 days) and row values(highlight rows that are online)

Is this possible?? in vba or excel??

Output that I am gunning for is as follows.

enter image description here

Upvotes: 0

Views: 1065

Answers (1)

Tim Williams
Tim Williams

Reputation: 166790

Ideally you try this out yourself first and we help you fix your code, but since this was a useful exercise for me...

Sub Tester()

    Dim pt As PivotTable, pf As PivotField, pi As PivotItem, d, clr As Long
    Dim rngTwoDays As Range, rngFiveDays As Range, rwOnline As Range, c As Range
    
    Set pt = ActiveSheet.PivotTables(1)
    pt.TableRange1.Interior.ColorIndex = xlNone 'uncolor
    
    'some code for figuring out what's what in terms of ranges etc
    Debug.Print "*** Row Fields ***"
    PrintInfo pt.RowFields
    Debug.Print "*** Column Fields***"
    PrintInfo pt.ColumnFields
    'done figuring out...
    
    'Start coloring
    
    ' x days labels >=5days
    Set pf = pt.PivotFields("WC")
    For Each pi In pf.PivotItems
        d = Val(pi.Name) 'days number only
        If d >= 5 Then pi.LabelRange.Resize(2).Interior.Color = vbYellow
        If d = 5 Then Set rngFiveDays = pi.DataRange 'for next block
        If d = 2 Then Set rngTwoDays = pi.DataRange  'for next block
    Next pi
    
    'the rest
    Set pf = pt.PivotFields("Order Category")
    For Each pi In pf.PivotItems
        For Each c In pi.DataRange.Cells
            If c.Value > 0 Then
                clr = -1 'reset
                Select Case pi.Name
                    Case "Online"
                        If c.Column >= rngTwoDays.Column Then
                            clr = IIf(Not Application.Intersect(c, rngTwoDays) Is Nothing, _
                                      XlRgbColor.rgbOrange, vbRed)
                        End If
                    Case Else
                        If c.Column >= rngFiveDays.Column Then clr = vbYellow
                End Select
                If clr > -1 Then c.Interior.Color = clr
            End If
        Next c
    Next pi
End Sub

'utility sub for printing field information
Sub PrintInfo(fldsCol As Object)
    Dim pf As PivotField, pi As PivotItem
    For Each pf In fldsCol
        Debug.Print pf.Position, pf.Name
        For Each pi In pf.PivotItems
            Debug.Print , pi.Position, pi.Name, pi.LabelRange.Address, pi.DataRange.Address
        Next pi
    Next pf
End Sub

Upvotes: 2

Related Questions