Color rows according to a specific column and a specific cell

[k0st4din]

Hello,
thank you very much, now the macro works and colors the cells, but it does not calculate them correctly or I have not explained correctly what should be calculated and calculated.
The idea is from the cell that is in brown color - the number that is in it to add + the numbers that are at the end of the table and if it is above this value, then to do the coloring, not as it is now.
I give an explanation (it applies to all these calculations for all cells but this is to show and catch the idea: with row 12 and in the example the brown one is in cell A12.
So there the number in the brown cell is 140, to make it yellow, the first increase it must be 140+130 (this is the first reduction that is made from cell AB12. And if somewhere in the row there is = 270 or more to be in yellow, then 140+260(i.e. AC)= 400 and it must be in the next blue color. That is, if it is greater or equal then to do the coloring. Because at the moment when it compares, if in the example it sees in a given row, as in the table 140, any next cell if it is above 140 makes it in yellow color, which is not true.


And so on until the last set number in the range from AB to AK (this is to at the moment, in the future I may need to add more numbers to the rows after AK for comparison to the right.
Please look at your macro, which you made years ago in my first post, how you calculate from the desired cell + the numbers at the end of the column.
I will make a manual coloring, which will be for example and comparison and I will attach it again.
I will do the test in the worksheet "bg" on the 12th row

140+130
140+260
140+390
140+520
140+650
140+780
140+910
140+1040
140+1170
140+1300
this is for this row, for all the others it takes the numbers for its own row and does the comparisons and calculations.

   If .Cells(1, c).Value >= T0 + T10 Then                
.Cells(1, c).Interior.Color = rgbSpringGreen 'new color rgbPowderBlue
            ElseIf .Cells(1, c).Value >= T0 + T9 Then
                .Cells(1, c).Interior.Color = rgbOrchid 'new color
            ElseIf .Cells(1, c).Value >= T0 + T8 Then
                .Cells(1, c).Interior.Color = rgbOlive 'new color
            ElseIf .Cells(1, c).Value >= T0 + T7 Then
                .Cells(1, c).Interior.Color = rgbPowderBlue 'new color
            ElseIf .Cells(1, c).Value >= T0 + T6 Then
                .Cells(1, c).Interior.Color = vbBlue 'new color
            ElseIf .Cells(1, c).Value >= T0 + T5 Then
                .Cells(1, c).Interior.Color = vbGreen 'new color
            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

.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T10        
.FormatConditions(.FormatConditions.Count).Interior.Color = rgbSpringGreen 'new color
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T9
        .FormatConditions(.FormatConditions.Count).Interior.Color = rgbOrchid 'new color
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T8
        .FormatConditions(.FormatConditions.Count).Interior.Color = rgbOlive 'new color rgbPowderBlue
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T7
        .FormatConditions(.FormatConditions.Count).Interior.Color = rgbPowderBlue 'new color rgbPowderBlue
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T6
        .FormatConditions(.FormatConditions.Count).Interior.Color = vbBlue 'new color
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T5
        .FormatConditions(.FormatConditions.Count).Interior.Color = vbGreen 'new color
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .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 = vbMagenta
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T2
        .FormatConditions(.FormatConditions.Count).Interior.Color = vbCyan
        .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T1
        .FormatConditions(.FormatConditions.Count).Interior.Color = vbYellow         
.FormatConditions(.FormatConditions.Count).StopIfTrue = True     End With

[Paul_Hossler]

Ver 8

[k0st4din]

Dear Paul_Hossler,
I don't know who you are, I don't know where you are from, but I know one very important thing. You are a great person with a very big heart.
For the second time, fate has met me with you and you have helped me again, saving me with this macro and your great help days of sitting in front of the computer and calculating every single worksheet and the many rows that I have in my tables.
Thank you with all my heart and soul.
Stay always so great and knowledgeable and generous!
A bow to you!
Everything works in the test table.
Tomorrow I will insert the macro into the real table and I assume that it will not give me any problems there either and I hope everything will be fine!

[Paul_Hossler]

<blush>

It took longer that it should have because I wasn't understanding the algorithm and calculations you were looking for

Let me know if there ary more changes

[Aussiebear]

It took longer that it should have because I wasn't understanding the algorithm and calculations you were looking for

.... Sigh. Neither did we.

[k0st4din]

Hi Paul,
I moved the macro to the new table, however, somewhere I need to change some parameter (number) that will start calculating according to my letters (columns), but I don't know what and where to change to start.
The original table is huge in size and I can attach a picture of the error (which is highlighted in yellow), if you can tell me (show) what to touch to get things working.
Thank you very much.

2025-07-08_130850.jpg2025-07-08_131449.jpg2025-07-08_131426.jpg

[Paul_Hossler]

Ver 009

To me your approach seems cumbersome


Some things to consider (ver 010)

I'd put a marker "Start" in row 1 of the range to start at and let the macro find it without asking me for column DM

cell.CurrentRegion returns a range of all contiguous cell and looping the rows is easy

I noticed that the .Interior.Color value for your Brown cell could change if color-picked manually, which would cause the macro to not find the starting cell
so I added a double click event that toggle the 'magic color' on or off so

[k0st4din]

Hello again, I agree with you and your suggestions and since I don't understand it at all, that's why I'm saying what I want to happen as a result. The idea is that apparently there is something in my table that prevents the macro from working as it does in a test environment. I gladly accept any of your suggestions, because you are God to me. I'll test and write again in a moment. Thank you very much Paul!

P.S Hi Paul, I just downloaded version 10,I'm uploading a video because I'm starting to feel like I'm an oligophrenic. It doesn't want to color the cells for me.
I removed all the already colored cells by the number and pressed the button to see if it would color them again but nothing happens.

link to video - >
https://youtu.be/K6Y13pEiAM0?si=RCBlLx7OSWXapgxs

[Paul_Hossler]

It's hard to tell from the video if you're doubble clicking

Run this little macro to see exactly what the .Color for Brown is

Option Explicit


'Public Const cBrown As Long = 4626167
Sub Macro1()
    Range("DM3").Select
    MsgBox ActiveCell.Interior.Color    '   unfilled cell
    Range("DM5").Select
    MsgBox ActiveCell.Interior.Color    '   marked cell
End Sub

Capture.JPG


The double click event if pretty simple

Option Explicit

'   one line version    :-)
'Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'    Target.Cells(1, 1).Interior.Color = IIf(Target.Cells(1, 1).Interior.Color = cBrown, 16777215, cBrown)
'End Sub


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    With Target.Cells(1, 1)
        If .Interior.Color = cBrown Then
            .Interior.Color = 16777215
        ElseIf .Interior.Color = 16777215 Then
            .Interior.Color = cBrown
        End If
    End With
End Sub

[k0st4din]

I tested the macro and it showed me the same as yours.
2025-07-09_165949.jpg
I can't figure out how to do this double click for the macro itself.
The question is that when I press the button to run the macro, it immediately says Done for literally a few seconds.
It's impossible for me to press it twice. Not that I haven't tried several times.
Or I don't understand where to do this double click (edit: I think I found it by double-clicking on cell A1, where my table color, which is different from brown, became white.)
I wanted to ask if you tested the macro, as I deleted the colors and then pressed the button, but nothing colored.

P.S - Oh my God, I discovered this double click quite by accident.You meant to say that if I want to make a cell brown I have to click twice, and if I want it to be colorless (white) I have to click twice again.

This is great, but the cells still can't be stained, for me there's a problem somewhere.....

[Paul_Hossler]

1. When I double click a brown cell it unfills and when i double click a not filled cell it turns brown. The workbook double click event is pretty simple

Capture.JPG


2. The command buttons on the worksheet to run the macros didn't have the correct macro so it didn't find it. I'm surprised that it worked for you
Capture2.JPG


3. I tried some other things so give ver 11 a shot. The Brown DC and the cell coloring still works for me. I missed a compatibility change I should have made

[k0st4din]

Hello Paul,
since I don't understand these high-level macros, I accidentally went to the farthest rows on the right of the tables and there I saw that I had some notes and that was where the problem came from, so that it didn't work properly. I completely forgot about them.
I'm calm now and I'll go to the most original table to fix everything.
Again, I want to thank you very much for this great help for me.
Again, I say you are an incredible person!!!

[Paul_Hossler]

This finds the first column with data by looking for 'Start" in row 1

        On Error Resume Next
        colStart = .Rows(1).Find("Start", After:=.Cells(1, 1), Lookat:=xlWhole, MatchCase:=False).Column
        On Error GoTo 0

This finds the last data column (EZ) by finding the right-most cell with data in row 2 *FA) and subtractubg 1 (EZ)
If there's notes, etc it'll find that cell and mess things up. Changed in ver 12

        'last column of data, last in row 2 - 1 col
        colLast = .Cells(2, .Parent.Columns.Count).End(xlToLeft).Column - 1

IF you're Ok with markers, ver 12 looks for markers "Start" and "End", ver 12

        On Error Resume Next
        colStart = .Rows(1).Find("Start", After:=.Cells(1, 1), Lookat:=xlWhole, MatchCase:=False).Column
        colLast = .Rows(1).Find("End", After:=.Cells(1, 1), Lookat:=xlWhole, MatchCase:=False).Column
        On Error GoTo 0

Other data cleansing changes in ver 12

Text iwithin the numbers are ignored
Text notes to the right ignored
All WS with 'Start' in row 1 are processed
'End' marked added in row 1 column before the threshold numbers

I tried to date stamp changed lines

[k0st4din]

Hi Paul,
the finale is fantastic on this great macro.
Once again, I express a thousand thanks to you and your great help.
Without you, I would never have managed this situation.
I repeat myself again, YOU ARE A GREAT MAN!!!

[Paul_Hossler]

Glad

Feel free to come back if you want something else

[k0st4din]

Hi Paul, I just sat down to move the macro and saw that you made a change that I ask you to revert to the way it was in the previous version.
Please, don't do it for all worksheets, but so that I can write which ones.
This is not ok for me, because I have a lot of other worksheets in this workbook.
I don't understand it, but let's do it the old way.

aryWorksheets = Array("Blagoevgrad total", "Burgas total", "Varna total", "Veliko Tyrnovo total", "Vidin total", "Vraca total", "Gabrovo total", "Dobrich total", "Kyrdjali total", "Kustendil total", "Lovech total", "Montana total", "Pazardjik total", "Pernik total", "Pleven total", "Plovdiv total", "Razgrad total", "Ruse total", "Silistra total", "Sliven total", "Smolqn total", "Sofia total", "Sofia oblast total", "Stara Zagora total", "Tyrgovishte total", "Haskovo total", "Shumen total", "Qmbol total") '"Burgas total", "Varna total", "Veliko Tyrnovo total", "Vidin total", "Vraca total", "Gabrovo total", "Dobrich total", "Kyrdjali total", "Kustendil total", "Lovech total", "Montana total", "Pazardjik total", "Pernik total", "Pleven total", "Plovdiv total", "Razgrad total", "Ruse total", "Silistra total", "Sliven total", "Smolqn total", "Sofia total", "Sofia oblast total", "Stara Zagora total", "Tyrgovishte total", "Haskovo total", "Shumen total", "Qmbol total"
'    For iWs = LBound(aryWorksheets) To UBound(aryWorksheets)
'        Call DoAllRows(Worksheets(aryWorksheets(iWs)))
'    Next

I think the latest version of the macro is for everyone, it's not ok for me.

For Each ws In ThisWorkbook.Worksheets    '   7/10/2025        
Set r = Nothing
        On Error Resume Next
        Set r = ws.Rows(1).Find("Start", After:=ws.Cells(1, 1), Lookat:=xlWhole, MatchCase:=False) ' tova Start ot tuk zapochva da sledi bonusite DM v momenta
        On Error GoTo 0

Everything else is super cool.
Thank you very much.

[Paul_Hossler]

1. Sorry

2. My prefered approach is to make macros smart enough to avoid having to change them everytime I add or delete sheets, rename one, or change to range of data to process

3. That's why I use VBA like .CurrentRegion, and some other statements to let the macro figure out what to do, instead of hard coding column DM in it

4. For the same reason to avoid changing the macro when there's a change in worksheets, I find it more flexible to use a 'Signature' on the appropriate sheets, like the word 'Start' in row 1

There's nothing wrong with reverting to the previous approach, but to me it just seems like a higher maintenance way of doing it.

But since I don't have to update it it's whatever works for you

[k0st4din]

I ask you, if only you could bring back that line where I write myself in which worksheets this calculation should be done. Start, End, let them remain. It is very intelligently done, if only you could bring back this Array, so that I can say in which ones, and not in the entire workbook. The rest of the things in version 12 are great, as I said before.

[Paul_Hossler]

Here you go although I still think it's better to just add or remove "Start" from the worksheets you want to process so that the macro doesn't need to be updated when things change

Make sure to keep the array of sheets correct

[k0st4din]

Hello Paul,
apparently I'm not expressing myself correctly.
Please, I want to say that the latest version 12 is great with this Start and End in each worksheet. The only thing I asked is that you return it to me so that I can record in which worksheets things happen. This Array , let everything else stay, don't change it, as I said it's super fantastic.
Let everything stay as you did, I don't know how to write it so that you understand me, I'll show a picture of what I'm begging you to return:

Let Start and End stay, it's great and I'll put them (and I've put them in each worksheet)
IMG-3363d991566036b86ad418775eee5704-V.jpg
IMG-ceb56388c66907224c614ff162f6bee4-V.jpg
In the workbook I have 78 worksheets and for this reason, I want in certain 28 (which I should write in the macro, only there to do these calculations and coloring.