Color rows according to a specific column and a specific cell

[Paul_Hossler]

OK

I went back you your macro in post #1

Added a worksheet loop to select which sheets to call your macro

There's a whole bunch of hard coded values that I have no idea where they come from, marked in bold

If they vary from sheet to sheet, you need a more sophisticated approach

Option Explicit

Sub DoAll()
    Dim wsNames As Variant
    Dim i As Long
    Application.ScreenUpdating = False
    wsNames = Array("Sheet1", "Sheet2", "Sheet3")
    For i = LBound(wsNames) To UBound(wsNames)
        Call DoAllRows_2025_22(Worksheets(wsNames(i)))
    Next i
    Application.ScreenUpdating = True
End Sub


Sub DoAllRows_2025_22(ws As Worksheet)
    Dim r As Long    
    With ws
        With .Range("DO3:EZ78") 'tova e diapazona v koti trqbva da se iztriqt vsichki condittional
            .FormatConditions.Delete
            .Interior.ColorIndex = xlColorIndexNone
            ' clear any empty, but text i.e. 0 length strings
            Call .Replace(vbNullString, "###ZZZ###", LookAt:=xlWhole)
            Call .Replace("###ZZZ###", vbNullString, LookAt:=xlWhole)
            ' clear the settings
            .Find What:=vbNullString, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False
            .Replace What:=vbNullString, Replacement:=vbNullString, ReplaceFormat:=False
        End With            
        For r = 3 To 79 'ot tuk sa redovete ot 3ti red do 79-Vi red
            Call AddInteriorColor(r)
        Next r
    End With
End Sub


Private Sub AddInteriorColor(rowNum As Long)
    Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long, T5 As Long, T6 As Long, T7 As Long, T8 As Long, T9 As Long, T10 As Long, T0 As Long
    Dim r As Range
    Dim c As Long
    Set r = ActiveSheet.Rows(rowNum)
    With r
        If .Cells(1, 157).Value = 0 Then Exit Sub    '   no threshholds 15ti red e pyrviqt bonus ili kolonata s godinata 2023(EA) naprimer
        T0 = .Cells(1, 117).Value 'DM KOLONA ILI SRAVNENIETO SPRQMO 1.12.2022
        T1 = .Cells(1, 157).Value 'tezi 131, 132, 133, 134 ili EA, EB, EC, ED sa bonusite +30,+60,+90,+120 naprimer
        T2 = .Cells(1, 158).Value
        T3 = .Cells(1, 159).Value
        T4 = .Cells(1, 160).Value
        T5 = .Cells(1, 161).Value 'new color
        T6 = .Cells(1, 162).Value 'new color
        T7 = .Cells(1, 163).Value 'new color
        T8 = .Cells(1, 164).Value 'new color
        T9 = .Cells(1, 165).Value 'new color
        T10 = .Cells(1, 166).Value 'new color
        Set r = r.Cells(1, 119).Resize(1, 38) 'tuk rcells oznachava ot koq kolona da zapochne da izchislqva ili inache ot 1.1.2023 (DO), a resize 12 oznachava kolko nadqsno koloni
    End With
    With r
        For c = 1 To 38     '   r starts in col C tuk syshto promenqme tow 25 e naprimer ot 1.2023 do 12.2024, t.e 25 reda nadqsno
            If .Cells(1, c).Value >= T0 + T10 Then
                .Cells(1, c).Interior.Color = 8388352       'rgbSpringGreen
            ElseIf .Cells(1, c).Value >= T0 + T9 Then
                .Cells(1, c).Interior.Color = 14053594      'rgbOrchid
            ElseIf .Cells(1, c).Value >= T0 + T8 Then
                .Cells(1, c).Interior.Color = 32896         'rgbOlive
            ElseIf .Cells(1, c).Value >= T0 + T7 Then
                .Cells(1, c).Interior.Color = 15130800      'rgbPowderBlue
            ElseIf .Cells(1, c).Value >= T0 + T6 Then
                .Cells(1, c).Interior.Color = vbBlue
            ElseIf .Cells(1, c).Value >= T0 + T5 Then
                .Cells(1, c).Interior.Color = vbGreen
            ElseIf .Cells(1, c).Value >= T0 + T4 Then
                .Cells(1, c).Interior.Color = vbRed
            ElseIf .Cells(1, c).Value >= T0 + T3 Then
                .Cells(1, c).Interior.Color = vbMagenta
            ElseIf .Cells(1, c).Value >= T0 + T2 Then
                .Cells(1, c).Interior.Color = vbCyan
            ElseIf .Cells(1, c).Value >= T0 + T1 Then
                .Cells(1, c).Interior.Color = vbYellow
            End If
         Next c
    End With
End Sub