Search code examples
vbaexcel-2010conditional-formattingworksheet-function

Excel conditional formatting highlighting rows when 3 to 10 most recent values in a row are above a limit


I have created a large spreadsheet with around 80,000 cells with an array of conditional formatting highlighting different points of interest. Two of these conditional formats involve large arrays that cause slowdown on the file. I'm looking for a way to make this more efficient.

The table reads left to right with the dates Jan 1st to Dec 31st along the top and down with various items and the limits identified in their respective row on the far right after Dec 31st. The date ordering prevents sorting of the data beforehand.

Below is the initial root for the formula. This is then replicated to both solve the problem and cause the problem. It looks through the unsorted row for non-blank cells, picks the top X number of values and compares them to the limit in Col $NG. It ignores the description columns with the -5 row reference and provides a 0 to avoid a #NUM error for insufficient values for LARGE().

IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2)

This is the first of 2 conditional formatting formulas that aims to highlight the row when 2 out of 3 of the most recent (furthest right) values are above the limit in $NG2.

=IF(COUNT($F2:$NF2)<2,"",SUM(IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),2)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),2)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),3)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),3)))-5)>$NG2))>=2)

Again, a replication of the root formula 10 times to catch 3 out of 10 of the furthest right values being above the limit.

=IF(COUNT($F2:$NF2)<2,"",SUM(IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),1)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),2)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),2)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),3)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),3)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),4)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),4)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),5)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),5)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),6)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),6)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),7)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),7)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),8)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),8)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),9)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),9)))-5)>$NG2),IF(ISERROR(INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),10)))-5)>$NG2),0,INDEX($F2:$NF2,SUMPRODUCT((LARGE(($F2:$NF2<>"")*COLUMN($F2:$NF2),10)))-5)>$NG2))>=3)

I considered an xlToLeft VBA Function with a Do Until 2 Or 3, but struggled to replicate the variable column ID within the Index Match.


Solution

  • In case it's useful to anyone else as a reference:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a, w, x, y, z As Integer
    Dim b As Range
    
    w = 0
    x = Target.Row()
    'Bypass limits column
    y = Range("NG" & x).Column()
    'Set column value while bypassing blanks
    If Cells(x, y - 1) <> "" Then
        y = y - 1
    Else
        y = Cells(x, y).End(xlToLeft).Column
    End If
    z = 0
    a = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    Set b = Range("F2:NF" & a)
    
    If Not Target.Cells.Count > 1 Then
        If Not Application.Intersect(b, Range(Target.Address)) Is Nothing Then
            Do Until y = 5 Or z = 2 Or w >= 3
                If Cells(x, y) >= 0 Then
                    If Cells(x, y) > Range("NG" & x) Then
                        z = z + 1
                    End If
                End If
                w = w + 1
                If Cells(x, y - 1) <> "" Then
                    y = y - 1
                Else
                    y = Cells(x, y).End(xlToLeft).Column
                End If
            Loop
            If z < 2 And y > 5 Then
                Do Until y = 5 Or z = 3 Or w >= 10
                    If Cells(x, y) >= 0 Then
                        If Cells(x, y) > Range("NG" & x) Then
                            z = z + 1
                        End If
                    End If
                    w = w + 1
                    If Cells(x, y - 1) <> "" Then
                        y = y - 1
                    Else
                        y = Cells(x, y).End(xlToLeft).Column
                    End If
                Loop
            End If
            If z = 2 And w <= 3 Then
                With Range("A" & x, "E" & x).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 12874308
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                With Range("A" & x, "E" & x).Font
                    .Color = -2
                    .TintAndShade = 0
                End With
                Range("A" & x, "E" & x).Font.Bold = True
            End If
            If z = 3 And w >= 3 Then
                With Range("A" & x, "E" & x).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 7434613
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                With Range("A" & x, "E" & x).Font
                    .Color = -13533715
                    .TintAndShade = 0
                End With
                Range("A" & x, "E" & x).Font.Bold = True
            End If
            If z <= 2 And w > 3 Then
                If Range("A" & x).Font.Bold = True Then
                    With Range("A" & x, "E" & x).Font
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                    End With
                    With Range("A" & x, "E" & x).Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    Range("A" & x, "E" & x).Font.Bold = False
                End If
            End If
        End If
    End If
    End Sub