Color Pivot Table data depending on row, column & data values VBA

Question

I have a macro, that dynamically generates n number of pivot tables. I am trying to code to ensure that pivot tables that meet a specific set of conditions are highlighted.

My conditions are as follows

1. all Values that fall in the Row online and are equal to 2 days (in one color "Orange")
2. all Values that fall in the Row 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"

The code for the same are as follows.

Sub conditionalFormatingPivotTable(ByVal Worksheet As String)

Dim pt As PivotTable, pf As PivotField, pi As PivotItem, d
Dim rngTwoDays As Range, rngFiveDays As Range, rwOnline As Range, c As Range

Set pt = Worksheets("Summary").PivotTables(Worksheet & "PivotTable") 'Setting the pivot table
pt.TableRange1.Interior.ColorIndex = xlNone 'Removing any kind of highlighting that exists


'Start coloring

' x days labels >=5days
Set pf = pt.PivotFields(Worksheet)
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
    If pi.Name = "Online" Then
        For Each c In pi.DataRange.Cells
            If c.Value > 0 And c.column >= rngTwoDays.column Then
                If Not Application.Intersect(c, rngTwoDays) Is Nothing Then
                    c.Interior.Color = XlRgbColor.rgbOrange
                Else
                    c.Interior.Color = vbRed
                End If
            End If
        Next c
    Else ' will highlight all other Order categories ("Stock & Store")
        For Each c In pi.DataRange.Cells
            If c.Value > 0 And c.column >= rngFiveDays.column Then
                c.Interior.Color = vbYellow
            End If
        Next c
    End If
Next pi

End Sub

Issue is that when I run the code, some of my PIVOT TABLEs (PT's) are highlighted (where conditions are met) whereas others don't get highlighted even though they meet the condition.

in the below example the pivot in btw got highlighted correctly, whereas the top and bottom PT's missed out on the stock data highlighting

Please help in figuring out where the error is.

Answer 1

Please, try the next code. It basically, use a different algorithm to set rngFiveDays range and created condition to skip checking of nothing object column:

Function conditionalFormatingPivotTable(ByVal Worksheet As String)
    Dim pt As PivotTable, pf As PivotField, pi As PivotItem, d
    Dim rngTwoDays As Range, rngFiveDays As Range, rwOnline As Range, c As Range
    
    Set pt = Worksheets("Summary").PivotTables(Worksheet & "PivotTable")
    pt.TableRange1.Interior.ColorIndex = xlNone 'uncolor
    
    ' x days labels >=5days
    Set pf = pt.PivotFields(Worksheet)
    Set rngFiveDays = Nothing
    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 rngFiveDays Is Nothing Then Set rngFiveDays = pi.DataRange
        End If
        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
        If pi.Name = "Online" Then
            For Each c In pi.DataRange.Cells
                If Not rngTwoDays Is Nothing Then '!!!!
                    If c.Value > 0 And c.column >= rngTwoDays.column Then
                        If Not Application.Intersect(c, rngTwoDays) Is Nothing Then
                            c.Interior.Color = XlRgbColor.rgbOrange
                        Else
                            c.Interior.Color = vbRed
                        End If
                    End If
                End If
            Next c
        Else
            For Each c In pi.DataRange.Cells
                If Not rngFiveDays Is Nothing Then '!!!
                    If c.Value > 0 And c.column >= rngFiveDays.column Then
                        c.Interior.Color = vbYellow
                    End If
                End If
            Next c
        End If
    Next pi
End Function

I could see your SortPT function which uses a big manually created array. Like a bonus, please try using the next function, able to automatically create it, according to the interval you set:

Existing array:

rngSort = Array("1 day", "2 days", "3 days", "4 days", "5 days", "6 days", "7 days", "8 days", _
    "9 days", "10 days", "11 days", "12 days", "13 days", "14 days", "15 days", "16 days", "17 days", _
    "18 days", "19 days", "20 days", "21 days", "22 days", "23 days", "24 days", "25 days", "26 days", _
    "27 days", "28 days", "29 days", "30 days", "31 days", "32 days", "33 days", "34 days", "35 days", _
    "36 days", "37 days", "38 days", "39 days", "40 days", "41 days", "42 days", "43 days", "44 days", "45 days")

The function to automatically create it:

Function arrDays(interv As String) As Variant
     Dim arr, frstEl As String
     arr = Split(Replace(interv, " ", ""), "-"): interv = arr(0) + 1 & ":" & arr(1)
     frstEl = IIf(arr(0) = "1", "1 day,", arr(0) & " days,")
     arrDays = Split(frstEl & Join(Evaluate("TRANSPOSE(ROW(" & interv & "))"), " days,") & " days", ",")
End Function

It can be tested in the next way:

Sub testArrDays()
   Dim rngSort, interval As String
   interval = "2-45"
   'interval = "2 - 25" 'just for testing that it works so, too
   rngSort = arrDays(interval)
   Debug.Print Join(rngSort, "|")
End Sub

Not knowing very well all the issued pivot tables peculiarities, I would suggest you to analyze if it is not possible to have cases without "2 days", but to be necessary similar formatting in case of "3 days" existance. Just a thought...