Delete all conditional formatting and coloring conditional on specific rows

[k0st4din]

Hello, everyone,
I've been trying to make my own macro for two months, but somehow I can't do it myself.
I am asking for your assistance on how to combine and make the conditions that I will describe.
I have a range of cells (this is in the example I'll attach) which is Range("C3:N60") - the first thing I want is to remove absolutely all Cells.FormatConditions.Delete,
after that I want in exactly selected rows to express given criteria for coloring these rows under the requested conditions (which I did manually in a macro)
I would be grateful if someone could help me because I am totally desperate with this task.

Sub test1()

    Range("C3:N60").Select
    Cells.FormatConditions.Delete
    
    End With
   
    Range("C4:N4").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$4+50"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$4+100"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$4+150"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$4+200"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("C8:N8").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$8+50"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$8+100"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$8+150"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=$A$8+200"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    Range("C3:N60").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(C3))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Range("C2").Select
End Sub

[Paul_Hossler]

Some things for you to think about

Lot of redundant code removed, no need to .Select and both rows were getting the same CF

I rearranged the CF tests in a 'get out' order

I like .Color and .ColorIndex instead of Pattern, Tint and Shade so I changed since I was more familiar with them. Put them back if you prefer of course

Don't think you needed the "=LEN(TRIM(C3))>0" so I left it out

I think it's important to use .FormatConditions.Count

Option Explicit         '   <<<<<<<<<<<<<<<<<<<


Sub test2()
    
    With Worksheets("Blagoevgrad total")     '   <<<<<<<<<< or specific sheet
    
        .Cells.FormatConditions.Delete
    
        With Application.Union(.Range("C4:N4"), .Range("C8:N8"))
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+200"
            .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+150"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+100"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+50"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        End With
        
        .Select
        .Range("C2").Select
    End With
End Sub

[k0st4din]

Hello and thank you very much for your help. But I have a question, two to be exact. 1st - can it be changed to active worksheet or say so I can insert more worksheets. The 2nd question is, after the changes on your part, range, I can see it, but then the formula a4+50 or 100 or 150 or 200, is always taken with A4, and actually I need for the next comparison to be A8 and not i don't see it anywhere like a8+50 etc. 3rd - question, can I on this line With Application.Union(.Range("C4:N4"), .Range("C8:N8")) - put more lines, for example C11:N11, C25:N25, just a few more lines. Thanks in advance! Be alive and healthy!

P.S. I don't see the last range where I say if it's blanks, don't color anything.
how about your suggestion for - I think it's important to use .FormatConditions.Count

[Paul_Hossler]

try this and see

P.S. I don't see the last range where I say if it's blanks, don't color anything.

It seemed that if the cell got past the Formula1:="=$A4+50" condition then it would not be CF-ed

Option Explicit


Sub test3()
    
    With ActiveSheet        ' Q1
    
        .Cells.FormatConditions.Delete
    
        With Application.Union(.Range("C4:N4"), .Range("C8:N8"), .Range("C11:N11"), .Range("C25:N25"))          ' Q2

            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+200"              '   $A4 not $A$4
            .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+150"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+100"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+50"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
            .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        
       End With
        
        .Select
        .Range("C2").Select
    End With
End Sub

[k0st4din]

Hello again,
thank you very much for your help, the macro works almost 100%.
What I noticed and did as a test is that in the whole table I have some rows (for example 33 rows) that are single (standalone), i.e. no criteria for more rows. And when I set in the macro (changed the rows) and reduced them to only one row, here -> With Application.Union - it gave me an error and didn't want to do the coloring, maybe because it's only one row.
In the table I gave as an example: I always compare it with the number in column A and below, and these additions in the example +50,+100,+150,+200 or +30,+60,+90,+ 120, etc. I take them from a column (as a note) from column O.
The other thing that struck me (that I hadn't thought of at all) is that if I make a few macros that run the various add-ons +50, etc., +30, etc., then every time I click for each one of the criteria, it will always erase all CFs from the previous one that is selected and always leave the last one as the selection which is not OK
I don't know how to clear this as a problem.
I was thinking if I make a standalone macro that first deletes all CFs and then starts enabling the criteria I want.

Thanks in advance and I believe we will get there and finalize things. Remain available!

[Paul_Hossler]

I'm guessing that you didn't mention that the 4 thresholds for each line could be different and are in cols O-R

Many of your cells have 0 length strings, which are not considered empty or = 0 for VBA

Sub test4()
    
    With ActiveSheet
    
        With .Range("C3:N60")
            .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


        Call AddCF(4)
        Call AddCF(5)
        Call AddCF(6)
        Call AddCF(7)
        Call AddCF(8)
        Call AddCF(9)
        Call AddCF(17)
       
        .Select
        .Range("C2").Select
    End With
End Sub




Private Sub AddCF(rowNum As Long)
    Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
    Dim CFormula As String
    Dim R As Range
    
    Set R = ActiveSheet.Rows(rowNum)
    
    With R
        T1 = .Cells(1, 15).Value
        T2 = .Cells(1, 16).Value
        T3 = .Cells(1, 17).Value
        T4 = .Cells(1, 18).Value
    
        CFormula = "=$A" & .Cells(1, 1).Row & "+"
    
        Set R = R.Cells(1, 3).Resize(1, 12)
    End With


     With R
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T4
         .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T3
         .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T2
         .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
     
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T1
         .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
    End With




End Sub

[k0st4din]

Hello
thank you very much for the serious macro changes, but I'm afraid you misunderstood me.
Now, the last table I sent and the addition in the columns P , Q , R - was only if you need in the calculation and tests to compare them.
Otherwise, in these 3 columns, these values are not there, they are entered in CF. (Otherwise it's a clever idea)


The other thing you mention about these 0's is a test file very close to the original one and the picture is almost the same as every single month ahead it will change and in every single cell there may be a value (some number).


In the last file you sent me, I decided to try and test by plotting numbers on row 21 and when I hit the macro, nothing like coloring came out on that row.
And the values are increased, to be +100,+200,+300,+400
I don't understand either, why didn't you color them?
I'm wondering why it doesn't color in the full range (after doing a check) C3:N60
2023-03-12_090329.jpg

I'm not that good at writing macros, but I have a feeling that you always take the values that are in/from O4:R4, and maybe I don't understand the macro and it takes its values from each row adjacent to it (so must be).


Could you tell me, I couldn't figure this out:
Call AddCF(4)
Call AddCF(5)
Call AddCF(6)
Call AddCF(7)
Call AddCF(8)
Call AddCF(9)
Call AddCF(17)
what is he doing
I can't figure out where you get that 4,5,6,7,8,9 and 17.
If when the macro is pressed, everything is deleted and then it recalculates and applies the colors where needed.
Thank you very much and I remain available.


And to mention again, the last option is quite clever, because it will save me a lot of writing and changes of ranges of cells, columns, values.
Thanks

[Paul_Hossler]

but I'm afraid you misunderstood me.

Most likely

Now, the last table I sent and the addition in the columns P , Q , R - was only if you need in the calculation and tests to compare them.

OPQR cols implied that each row might have different thresh holds

I'm not that good at writing macros, but I have a feeling that you always take the values that are in/from O4:R4, and maybe I don't understand the macro and it takes its values from each row adjacent to it (so must be).

Yes, not required but easier since otherwise the 4 thresh holds would have to be passed to the sub. That was my first approach but I decided that it was not very elegant. I can put it back if it's a problem

I can't figure out where you get that 4,5,6,7,8,9 and 17.

The subroutine definition might give you a hint since I like to give variables meaningful names

Private Sub AddCF(rowNum As Long)
    Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
    Dim CFormula As String
    Dim R As Range
    
    Set R = ActiveSheet.Rows(rowNum)

In the last file you sent me, I decided to try and test by plotting numbers on row 21 and when I hit the macro, nothing like coloring came out on that row.

I didn't spend time doing every row, I only did some that had a value in OPQR, I just didn't include row 21

       Call AddCF(15)
       Call AddCF(17)
       Call AddCF(21)

It's easy enough to have the macro do all rows, keying off of OPRQ values (skip rows where the col O is blank

Sub DoAllRows()
    Dim r As Long
    
    With ActiveSheet
        With .Range("C3:N60")
            .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 60
            Call AddCF(r)
        Next r
    End With
End Sub

[k0st4din]

Hi, now it is clear to me about these CFs that I have to add myself and it will be really easy to determine which lines to monitor.
The new proposal is also good because things happen even faster.


However, in the test, the table does not calculate correctly, which is not good for me.
I give an example from the table itself and the last macro:
On rows 33, 45, 47, 48, 49 - the coloring is not true.
on
33 -> 331+350=681, and it gives me the blue color 343 - this is not true
45 -> 48+ 30=78, in the table 41 and 38 as values should not be in blue color, they are less than the minimum required number 78
48 -> same situation, on 49 -> there is absolutely no way the number can be less than 853 and be red, if it is 853+30=883 I agree it should be first color, if it is 853+60=913 it should be second color etc. I agree but in this case it is not correct


While you are writing to me, I will try the previous macro adding CF because I didn't understand it and I will try the old macro to see the result.
2023-03-13_070537.jpg





P.S. - Just to add because I did the tests with the previous macro and added the Call CF, but when I opened the CF itself I saw that it shuffled the lines and that's where the problem comes from. For example, if it is A47, it sends me to CF to monitor, for example, A58, and that is where the incorrect coloring comes from.I have no idea why

[k0st4din]

I've been in front of this table and this macro all day.
I feel like I'm an oligophrenic.
What struck me was that where the colorings were not correct, they only became correct when I clicked on a specific row and then it calculated correctly.
I have no idea why this happens.

2023-03-13_173825.jpg

2023-03-13_174058.jpg

[Paul_Hossler]

I changed the colors since it made it easier for my old eyes to see

Capture.jpg

Here's the way I look at Row 33


A33 = 331

C33 = 365


CF rules for C33: A33 + (350/700/1050/1400)

331 + 1400 = 1731 >>> C33 NOT > 1731

331 + 1050 = 1381 >>> C33 NOT > 1380

331 + 700 = 1031 >>> C33 NOT > 1031

331 + 350 = 881 >>> C33 NOT > 681

It seems to work and there should be no CF color. Am I missing something???


Same for your row 9 question

[k0st4din]

Hello again, Paul_Hossler
don't worry about changing the colors, I'll change them to whatever I want.


As for the macro and accounts:
Yes, they are correct and there are no two opinions about it.


Please look at post number 10.
Either I'm oligophrenic or I have some kind of problem. I'm using office 2007 (my personal preference, I can use another but I don't want to).


In post 10 I mentioned, now I will write again, I have no idea why when I clicked somewhere in the table (inadvertently/arbitrarily selected cell) and pressed the button to activate the macro it colors the cells wrongly (I will show a picture, how it moves and calculates the wrong coloring ) because it takes another cell for comparison.
However, when I clicked exactly in the given cell, the calculation for that same row is correct.
This is the first time this has happened to me, it goes and selects CF chaotic cells, but not what it is told to do with that CF.
Am I misunderstanding it or am I having some problem Paul_Hossler?
The macro is perfect and I'm very grateful, that's the only thing that bothers me, why does it shuffle the lines, it's kind of crazy to me.


2023-03-14_071011.jpg

2023-03-14_074535.jpg

P.S - I think my problem comes from the fact that I am using office 2007.I tried on newer versions and everything works fine there.
Is there an option to tweak it to work on my version?

I guess there are some differences in the writing of the macro itself, I can't think of anything else as a problem.
Thanks in advance!

[Paul_Hossler]

What is the macro that you're using to call it?

I see there's a [Button1] on the worksheet

Maybe better to attach your actual workbook if you can

[k0st4din]

Hi, yes is a button1, the macro is in.

[Paul_Hossler]

... and the macro is ...?

Attached Workbook?

[k0st4din]

just to get home, but the thing is, I haven't reached my workbook yet. When you send me your file, with the macro in it, I try in your file, in your workbook. And when I open it with office 2007, on my computer, it gives me the wrong calculations that I showed in the pictures. When I went to the office and opened your same file in a newer version of the office suite, things calculated the right way. For this reason, I think the problem comes from office 2007, which I use all the time. And since it happened to me another time, writing a macro in a different way for different office packages, maybe this is where the problem comes from.

[Paul_Hossler]

I saved my WB as a previous version and there was a compatibility alert: "Only the first three conditions fill be displayed"

Capture.JPG

[k0st4din]

Hi Paul, is there a way to do something with this macro so that it works with office 2007 as if there are no other newer editions. I'm just really desperate.
Thank you in advance!

[Paul_Hossler]

Hi Paul, is there a way to do something with this macro so that it works with office 2007 as if there are no other newer editions. I'm just really desperate.
Thank you in advance!

Apparently not using CF, only other way would be hard coding the interior color. Macro can use Application.Version to figure out which method to use

Option Explicit


Sub DoAllRows()
    Dim r As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        With .Range("C3:N60")
            .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
        
'   https://www.rondebruin.nl/win/s9/win012.htm
'            Excel 97 = 8
'            Excel 2000 = 9
'            Excel 2002 = 10
'            Excel 2003 = 11
'            Excel 2007 = 12
'            Excel 2010 = 14
'            Excel 2013 = 15
'            Excel 2016 = 16
'            Excel 2019 and Excel 365 also give you number 16
        If Application.Version > 12 Then
            For r = 3 To 60
                Call AddCF(r)
            Next r
        Else
            For r = 3 To 60
                Call AddInteriorColor(r)
            Next r
        End If
    End With


    Application.ScreenUpdating = True


End Sub




Private Sub AddInteriorColor(rowNum As Long)
    Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long, T0 As Long
    Dim r As Range
    Dim c As Long
    
    Set r = ActiveSheet.Rows(rowNum)
    
    With r
        If .Cells(1, 15).Value = 0 Then Exit Sub    '   no threshholds
    
        T0 = .Cells(1, 1).Value
    
        T1 = .Cells(1, 15).Value
        T2 = .Cells(1, 16).Value
        T3 = .Cells(1, 17).Value
        T4 = .Cells(1, 18).Value
    
    
        Set r = r.Cells(1, 3).Resize(1, 12)
    End With


    With r
        For c = 1 To 12     '   r starts in col C
            If .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 = vbYellow
            ElseIf .Cells(1, c).Value >= T0 + T2 Then
                .Cells(1, c).Interior.Color = vbGreen
            ElseIf .Cells(1, c).Value >= T0 + T1 Then
                .Cells(1, c).Interior.Color = vbBlue
            End If
         Next c
    End With
End Sub






Private Sub AddCF(rowNum As Long)
    Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
    Dim CFormula As String
    Dim r As Range
    
    Set r = ActiveSheet.Rows(rowNum)
    
    With r
        If .Cells(1, 15).Value = 0 Then Exit Sub    '   no threshholds
    
        T1 = .Cells(1, 15).Value
        T2 = .Cells(1, 16).Value
        T3 = .Cells(1, 17).Value
        T4 = .Cells(1, 18).Value
    
        CFormula = "=$A" & .Cells(1, 1).Row & "+"
    
        Set r = r.Cells(1, 3).Resize(1, 12)
    End With


     With r
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T4
         .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T3
         .FormatConditions(.FormatConditions.Count).Interior.Color = vbYellow
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T2
         .FormatConditions(.FormatConditions.Count).Interior.Color = vbGreen
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
     
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T1
         .FormatConditions(.FormatConditions.Count).Interior.Color = vbBlue
         .FormatConditions(.FormatConditions.Count).StopIfTrue = True
    End With




End Sub

[k0st4din]

Thank you so much
i downloaded the file and opened it when i clicked your button with the macro i immediately got the error in the picture i will attach.
2023-03-16_100157.jpg2023-03-16_100225.jpg

Sorry, but when I entered the site I saw a purely unintentional omission and I added it and the macro worked.

 If Application.Version > 12 Then

If Val(Application.Version) > 12 Then

You are an amazing Man Paul.
Thank you with all my heart and soul for this help.
Big bow to you.