View Full Version : [SOLVED:] Color rows according to a specific column and a specific cell
k0st4din
07-01-2025, 07:47 AM
Hello everyone,
I have been using this macro for many years (Thanks to Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler) )
(link to old thread -
http://www.vbaexpress.com/forum/showthread.php?70692-Delete-all-conditional-formatting-and-coloring-conditional-on-specific-rows&p=419047&viewfull=1#post419047
which works on the principle of searching and comparing a certain column (and the values in it) and according to the numbers placed at the end of the table, if there is an increase, it colors the given cells in the colors I have specified.
Due to some necessary changes in the recalculation, I am asking for help and assistance on how to rework it so that it does absolutely the same coloring, but here comes the problem:
Can it be done so that I can enter in the macro itself exactly from which column and exactly from which row the information should be taken and still do the coloring.
One type in the specified range, to be able to do the calculations again, but one type (as if) each column and selected row is independent.
The idea is to be able to write in the macro exactly which column to start the comparison from and exactly which row.
For example, column EM and row 10, column EO and row 5, and so on, I write for each needed row and branch if there are numbers at the end of the table.
Option Explicit
Sub DoAllRows_2025_22()
Dim r As Long
Application.ScreenUpdating = False
With ActiveSheet
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
' 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 Val(Application.Version) > 12 Then 'If Application.Version > 12 Then
For r = 3 To 78 'ot tuk sa redovete ot 3ti red do 78ti red
Call AddCF(r)
Next r
Else
For r = 3 To 79 'ot tuk sa redovete ot 3ti red do 79-Vi red
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, 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 = 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
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, T5 As Long, T6 As Long, T7 As Long, T8 As Long, T9 As Long, T10 As Long
Dim CFormula As String
Dim r As Range
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 naprimer
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
CFormula = "=$DM" & .Cells(1, 1).Row & "+" 'tuk $DM, se promenq na bukvata(kolonata), koqto ni e za sravnenie, naprimer $DM sprqmo 12 mesec na minalata godina
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, a resize 12 oznachava kolko nadqsno koloni
End With
With r
.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
End Sub
Paul_Hossler
07-01-2025, 09:51 AM
I'm sure it's doable, BUT please attach a workbook and explain with examples
Can it be done so that I can enter in the macro itself exactly from which column and exactly from which row the information should be taken and still do the coloring.
One type in the specified range, to be able to do the calculations again, but one type (as if) each column and selected row is independent.
The idea is to be able to write in the macro exactly which column to start the comparison from and exactly which row.
For example, column EM and row 10, column EO and row 5, and so on, I write for each needed row and branch if there are numbers at the end of the table.
Originally the test was against Col A in each row
32080
k0st4din
07-02-2025, 12:54 AM
Hello Paul_Hossler,
I'm very glad that we're writing again.
So, let me start like this - in the tests we did then for the macro above, we really started from column A, but over the years the table grew and for each subsequent year, I changed where it should start checking and making comparisons and then coloring the cells.
So whether it will be column A or some other EO, EM, AZ doesn't matter. It starts from a selected column and checks each row, where at the end of the table there are set values and starts coloring, if there are no values at the end of the table it skips the row and does so up to and in the range that is set. No matter if it is 2 or 200 rows.
The macro simply works super fantastically and correctly.
Now, however, since there are some changes, I need to do the same thing again, but to be able to record exactly from which column and which row to start checking to the right and if it matches the given amount to color the cells.
In the example, I have given a small part of the table and the idea is - from where it is brown, from there to start checking to the right. I record the initial brown cells, and in the example you will see all of them. S5, Q6, M8, T9, etc. to where the range is defined (as in the other macro)
This as a postscript - Yes, we will do tests, again from column A, but in my table they will be completely different.
Thank you very much and I remain at your disposal!
P.S. - And one more thing, is it possible for the columns not to be with numbers but with their letters?
Paul_Hossler
07-02-2025, 07:01 AM
What are the numbers in AC:AK?
What is columns 117, 157, ...
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
k0st4din
07-02-2025, 08:03 AM
Hello,
the code you wrote a long time ago and to this day it works great, for which I am infinitely grateful.
Now these numbers I don't know why you decided then that instead of the names, i.e. the letters of the columns should be numbers (for example column A is 1 and so on to the end, as if you were using R1C1 REFERENCE style), I have no idea why it was done that way, but to this day I count my columns that way.
That's why I asked you in the postscript if it could be with letters, not numbers, because it is very laborious to count the columns.
In this case, this 117 (in the test table it should be 1) is the column from which it is compared (in this macro yours, and the rest from 158 to 166-> are also columns, are the colors that change according to the values that are at the end of the table from AB to AK (and in the test table, respectively, these numbers are from 28 to 37).
But all this in the macro and for the old calculation, which made a comparison in one column and in all rows (in each row).
Paul_Hossler
07-02-2025, 08:52 AM
You'll have to take me through it again
Using S5 = 0 as example
Q1 - What do you test against
Q2 - What color(s)
Q3 - Col S is the 4th month so is AF5 the test somehow? Just seems like AC:AK are MUCH larger that any of the data in P:AA
32082
Q4 - Where did the 50 come from in AB5?
Q5 - Why are AC:AK rows different? Increasing colum I can guess, but why do the rows change within a column?
k0st4din
07-02-2025, 09:15 AM
So,
S4 in this case is empty, but it still checks if there are any numbers from the next cell T5 (i.e. the 5th month, and until the end i.e. the 12th month cell AA).
If there are none, it does not color, if there are, it looks at whether they are in a given range to determine the color or in other words - each subsequent month is checked according to the desired cell (in brown) and if they are between 50 and 99 it should be in yellow, if they are 100 to 149 it should be in blue and so on until the end. That is, as in the macro >=.
You ask where these 50 came from, etc. - from there I set how many and after which value to change the color.
That is my problem, because for each row there is a different month (cell) from where I have to start tracking, when numbers have accumulated and it has to color the cells in a given color.
The next row in the example interests me to start checking from Q4 to the end (i.e. up to 12.2025 inclusive)
The next row 7 currently does not have any values in the AB:AK range (it can check it, but it will not show anything, at least for the time being, if in time it decides to have some values that will be entered in AB:AK, then it will calculate and color it.
The next row and column is M8 and from there to the right it starts checking.
I have chosen the colors and they are on line 1 from P to Y and in the macro itself they are defined here
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 = 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
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, T5 As Long, T6 As Long, T7 As Long, T8 As Long, T9 As Long, T10 As Long
Dim CFormula As String
Dim r As Range
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 naprimer
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
CFormula = "=$DM" & .Cells(1, 1).Row & "+" 'tuk $DM, se promenq na bukvata(kolonata), koqto ni e za sravnenie, naprimer $DM sprqmo 12 mesec na minalata godina
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, a resize 12 oznachava kolko nadqsno koloni
End With
With r
.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
And it is very important that it can also work with older versions of the office suite, as it did in the old macro.
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 Val(Application.Version) > 12 Then 'If Application.Version > 12 Then
For r = 3 To 78 'ot tuk sa redovete ot 3ti red do 78ti red
Call AddCF(r)
Maybe I should add something else and why I'm having trouble.
The idea is that in a given month there are some changes in the prices of certain products.
If I have any change, I decrease or increase the numbers in AB:AK for each row where necessary.
For this reason, I'm looking for a way to start calculating, coloring from the cell I set and to the right until the end of the year.
When the next year comes, I will decide whether to change the cell or it will remain the same and the macro will move forward and do the check for the next year as well.
Paul_Hossler
07-02-2025, 09:39 AM
What about the rest of the number, P5, P6, etc. that were not grey?
So
1. Check each cell in P3:AA37 (e.g. S5)
Using row 5 as example
P5 = 1, Q5 is blank so no color for P5
Q5 is blank, but R5 = 3 so no color for Q5 since 3 < AB5 - 1
R5 = 3, but S5 is blank so no color for R5
S5 is blank, but T5 = 2 so no color for S5 since 3 < AB5 - 1
T5 = 2, but U5 is blank so no color for T5
What do you mean accumlated?
These cells in row 1 are blank in your example. How do the factor in?
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
k0st4din
07-02-2025, 10:06 AM
No, no, not backwards but from the brown color (or gray) I don't know how you see them on your computer.
The check should start from the brown cell To the Right, not before it.
In the example you give, the numbers are very small and will not be updated until they reach the numbers I wrote in the range AB:AK.
If from the colored cell to the right let it be this row P, the check should start from S5 to the right and if for example in the cell T5 there are 50 to 99 (i.e. >=) it should be yellow.
If the cell is empty, it does not color anything (maybe there was no product and it skips a given cell on the same row.
There is no range, this ->> 1. Check each cell in P3:AA37 (e.g. S5)
this is not the case - if you mean from S5 to do the check everywhere.
I can tell the macro to check the specific row from D5 to the end of the table without taking into account AB:AK in this example.
In the previous comment I wrote that I copied the macro from my workbook, in this test book the range is AB:AK
Paul_Hossler
07-02-2025, 10:58 AM
Sorry to be dense, but ...
What are the colors in P1:Y1 for?
Why the brown cell? There's lots of others with data that are not brown
Only check from a brown cell to the right?
So S5 is empty and T5 = 2 < 50 so leave S5 alone and no color for T5?
What color should P25:t25 be (I hanged some numbers) and how did the logic work?
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAABX0AAACmCAIAAAAJTLvcAAAgAElEQVR4Ae19z6sc R5Zu/B zGtCqt24Vntq8XdPeaWG0MO52vVlcL98bBrxpQ9PdpsvM6sL05urHHaEnoauuVqslq0sXjS5qob FhmnYZi4EWKmGuQQgMxiRaaCXIR9a59 jcyMyoyshfcSK/RFxFZfzI831fZOSJU5FR5vDw8NWrVykOMAAGNmPg1atXh4eHz549S odL1 fPbs2fPnz1 /fr3ZlWMo9fr16 fPnz979uzly5cWf0 ePFkulxiOYpAZGMAAGAADYAAMgAEwAAbAgGDAiDSSYAAMbMrA4epIahwvXrx4/vz5pteLq9zz589fvHghyTs8PFwul3GhBBowAAbAABgAA2AADIABMAAGMgYQd0A/AAM DLx69erJkydJjWO5XCpd6fDFF5/v7l784ovPfYhb1Xn9 vVyuZTkPXnyBCsdvPlERTAABsAAGAADYAAMgAEwEDIDiDuErA5sC5qBr7/ OqlxfP3110HDKzHu00 nH3/8i9/97t/H47efPn1aUmr9aYs9pWysx4kSYAAMgAEwAAbAABgAA2Bg8Awg7jD4LgACfBmwZs5JxaNwpn14eO g2Z20Bd3Urt qrDbu7F8 effe777776quvdncvWq1V mixV8hGpQZRGAyAATAABsAAGAADYAAMgIEwGbDjDqdOnTl18jhz6lT6zXmy/vw36UenzqTpAX/k8ufPnErTb8IECavAQBsMWDPnpOJRONP 2 oos9adW1ar7Pznq6MsN3/ 6dOn4/Hbe3t7 SyPMxZ7hWx4NIsqYAAMgAEwAAbAABgAA2AADITGgB13IPus AIbfeqjg49OneK4w0cH6cFHpzgXCTAwKAasmXNy8hiP3x6P3z557sSnspl2WXCh7HzqdVQKOtCG DmfPvjsev/3pp9M6OzuwsRZ7ZWxweSTAABgAA2AADIABMAAGwAAYUMpAhbjDRwfpmTOn5HqHUx8dfHP jFLkMBsM1GTAmjknJw/vuEOapvkQQ/5MHeMrBR3SNKW4w3j89tmz79bcUZLNtthD3IGZQQIMgAEwAAbAABgAA2AADETGwKZxh2/S9KMz589/c8Bxh2/S9MyZ8/wKRmS8AA4YWMuANXNOKh7umbYMNMj0WqvWFqgadKAG6SWL3/3u39e2v2EBiz03Gxu2iWJgAAyAATAABsAAGAADYAAMBMjApnGHM e/ eb8Gfn xUGarlY/ZPtByD0gAgQJk8BAGwxYM ek4rF2pk3hhqpBB/dWkX5BhzRNP/vs9nj89mef3U7TdG9v71/ 5f98 uk0TdPf/e7f//mf/7f1wxZ///vfz58///e//92iXZ632FvLhtUUPoIBMAAGwAAYAANgAAyAATCghYGN4g4HaXr zEdp o2MO5z/Jj1z6gytdzhI049OfcT7PmgBDzvBgGTgiy8 H4/fzm9eUHbemjknJ48671mwVQ9WB3/cJOGILDiy1rb86adT cOZe3t74/HbH3/8i08/ne7uXvzuu sFmSIgbKsMxZ7iDtYBOIjGAADYAAMgAEwAAbAABiIhoGN4g6nVhtIpmkq4w6SAlr7gHcuJCdIa2 QgH2LIn2Fc1sw5OXnUjzv4rXdI07QwvlB4krGsTZw9 7Zs /KYhR3kGestAw0yDQVs9hD3MFiDx/BABgAA2AADIABMAAGwEA0DKyPOxyk6alTH538bc1T6cFHkgLEHSQbSKtmQAYaZDoPypo5JxUP90 xbvl4h03kzCs9YUQbrY2EVx8nCzR3Onn33449/4aiVpimFG/7rv/4r/9qFxZ6bDfdVkAsGwAAYAANgAAyAATAABsBAyAysjztI6 V6h48OUv5NzfPfpOfPnEnTb2RhpMGAUgYo3LC7e7HwtQsGZc2ck4qHY6adDzTkz7AZZQmONXCir OTa87S5w/37/8kl9/b2zp5996c//Umapl999RWfzyfyKx2ojMWeg418mzgDBsAAGAADYAAMgAEwAAbAgCIG/OMOaZqeOf8NrYPgAIQi5DAVDDgYcK90oIrWzDk5eXi/Z1EWYig770Dx eefz fzzz//3FFmk6yPP/4FhRjSNN3dvUj7St6//5/j8duffjrd29vbpBGrjMUe4g4WP/gIBsAAGAADYAAMgAEwAAaiYaA47hANPAABA 0xYM2ck5OHX9zBHVxw5xYi/Z// Z/C85VO/vSnP9ndvUhVdncvfvzxL2gjyY8//gWfr9RgmqYWe4g7VCUQ5cEAGAADYAAMgAEwAAbAgBYGEHfQohTsDI4Ba acVDwKZ9qHh4dunGsLuKtXyt3b2/vuu /u3//Ps2ffzf9iRaWm8oUt9grZyNfCGTAABsAAGAADYAAMgAEwAAbUMYC4gzrJYHAoDFgz56TiEfhMmz e5OHv2XfcODn56WOwFzoYfRtQCA2AADIABMAAGwAAYAANgIE1TxB3QDcCADwOvXr168uRJUuNYL pevX7/2uXZXdT777Pbe3t7Tp08bv Dr16 Xy6Uk78mTJ69evWr8QmgQDIABMAAGwAAYAANgAAyAgd4ZQNyhdwlggEoGDldHUuN48eLF8 fPVYKvbfTz589fvHghySM azeMBsAAGAADYAAMgAEwAAbAABgIjgFzeHiIrxmDkwUGBczAq1evDg8Pnz17ltQ7Xr58 ezZs fPnwe 6qFZKV6/fv38 fNnz569fPnS4u/JkycYjpplG62BATAABsAAGAADYAAMgIEQGMjiDk ePPkaBxgAA5sxQNPjpInj5cuXL168WC6Xm105hlLL5fLFixf5oAPReXh4OCg2YlAUGMAAGAADYA AMgAEwAAbAwDoGTBOzJ7QBBsAAGAADYAAMgAEwAAbAABgAA2AADICBAgYQdyggBafAABgAA2AAD IABMAAGwAAYAANgAAyAgUYYQNyhERrRCBgAA2AADIABMAAGwAAYAANgAAyAATBQwADiDgWk4BQY AANgAAyAATAABsAAGAADYAAMgAEw0AgDiDs0QiMaAQNgAAyAATAABsAAGAADYAAMgAEwAAYKGED coYAUnAIDYAAMgAEwAAbAABgAA2AADIABMAAGGmEAcYdGaEQjYAAMgAEwAAbAABgAA2AADIABMA AGwEABA83EHR4/flzQdryngDdebTNk0Ddufff39x8P6djf349bUEYn71yZ5gJRJoaDlOQD3ii7MYOCvkxFlAnoG6W sDAr6MhVRJurr20zc4auvvoqS3zJQwFvGTBznoW8cOpahuHv37uMhHXfv3i2jIrLz8s6V6chgWn CGg5SAA6/VASL7CH0jE9SCA30tQiL7CH0jE9SCU1/fZuIOf/vb3yzL4v4IvNA3JgaG1p/n8/njIR3z Tym7urAInuyTDuqRJA1HKQkFvBG0GkdEKCvg5wIsqBvBCI6IEBfBzkRZNXXt5m4w3//939HwObmEIB3c640loS GlXb3GbEHTbnSldJeefKtC4UVa0dDlJiBnir9hBd5aGvLr2qWgt9qzKmqzz01aVXVWvr6 sfd3j69Cmb 8UXX3C6m8R0kRgzMsdHMpt0c126Spd4zWR2jPLN/7OJv3AeRHWJl8ybzBJGOzImWUw9zPau0hneRZKY0ZSRcmIxHXkb71GxM7xk2yxJjJkw2IkxSTLz MNu7yp///OfHnRznHz/ h5/933/42T/l/01 9k PH/ /Tqx4/Oc//9mbq0oVqT/nRyczmU1HJkkWlVrzKCx7skx7NLW2Co3M Vs1P2K3PYK1jTRJkjKwxJI1jrWtdY948 IaY9p2PzrA65C4ELIxpj2Vw8Tbnsod4HXfv9YTuT1labjoAG9Zf 7lCdUNXvnAKpR7MkvafhJ1qW ZxJKHMrllmfrpbvQt1JRIyN wNIHKe2L1wSZJUh v5/T16dOnd 7cYQyPHj3idAeJ0XQhH/YUg2iJ4kI4XeLNu z0kMh3tUJTGznZJV4aKeRclPTN /eNQCtspDO8hcMiDRnteTl5yJ3hTZIkj85MZt08Dhn4nTt3Hnd /PIvj//Xz84 /su/dX7lx3KsZhLaSBT257JHYxsGyJ4s041fa7pIRmY0mkzkSEVXyY/Yo mi1R7eKtIkSRxg Y6W43Pbd3SPePPiduB tI3XLXEecuN3k9Ug8FqE1Pzovn8tdzrvgNW8er56j/r28oTqAK8kuUzuzuIO3eAtgympKJNblqmf7gCvA2x fM772PUxyhbq4/WJO1DQQfqyf/nLX6RZraZJAOsLcJqKS9enVRu6xJvvVeTqterIWux1iXc0XeRdefLtOpuKd4a3cFgsPGkp0uzHz vDSFNQKEXaPF3GHZvsPt1YmZeEgxrUaTMieLNMNXoKaomFqupgZM7LGpTzYth9PrSJNksQBtnBk pm7QXmS8R7x5cTt4HLeN1y1xIeTGbyjZIPBKNuqn/e5f6zFd3wxuoUd9e3lCdYCXuXXcy53FHbrB6 jVzEaZ3FygkUQHeB1grfG5A5Xr460cd Cgg4w7HBwcNKLfJo2YyaxwQBxNF 05OpZhHePN4yr09iwjG/zYGV6Hg16me4MwuanO8JYNi9ZQwoa1lOgdb0u4ypr97LPPHnd 9Lje4bPPPiujotnzvfdn2ZNluiWYhXjzNy8Na1Z4okGT2kOarN6NMaPpbGIKwZY9dmfZi1NtvTz VI968uJKiBjWVTbWKV9pfKHEhZGle42ngbZBS1pQTsvEycUfThdLxyt2fC0loe0Ve2/1ZCsoAOcG5HcxI6Vod4GV0nGCYMuHOlSXrpNvGyyg4Ia2Vt3A3EtfHWy3uIIMOMu5w7949SUR7a ce8tBvGCVpneMsGxC7BJknSGd7CxSzE WSW5NdBtNTTOsNbOI4UnmwJaff9udUXzzZk6fbt2487P3qMO9y fXtDZmoWK u68tFY8xLu6vLOlWl3raq5cvjNv0ORBzuaLgpj5VWvW1a PaTWl/kW2DK5y xs6nxfeMsex47zjUBuFa9b4rahFfIDvIW0 J10DFZ0/3a2TJjt71HfsiErP2iztfUTbeOVFjrkllmySuPpDvBKLNZTScIpk1uWqZ9uG68bLHddWaw KEcL9fFWiDtYQQcZd js9 EdXxx1uQSgM7yFT30ioVVH1upzneF13DmOLMva h87w1s4LFrvW9aHs7aFzvCSJXSr0r6SncWSJAm3bt163PnRY9zh1q1bEn576cL XDiItWSD7Mky3ezl ElP3 kbM5G e E fPk1aw2a1B5SSzsr7m99bBCRu6m 8FpsSCNpHWxLSzxaxWuBymta2J NMbLPSyrqp3vH2 rdmuenVbyOwYq0bm9dQx4pnWkVr7s/0xOK97SWifZEbxuv5Nkhd2cudAd4HTAlG2UOiSxTP902XjdYyp3Msk0Pu3n7vj7eTeMO aCDjDvIdH0VHS04Bsou4w6d4aUxVA6OlG7vkV9Ifmd4HSOjI6vQ5jonO8Nb9hTs2BXoDK8lCsPv ZrjkqyPuwFQ0myh7zMsHZ7NXtFqTPVmmrWJ1PtKDRo7AZjKT4bM82LbX LSElLYbNGZUBjY/R61D7OZ1 8JrTWmkwa3GHdrDu1ZiB2QJv9l073jzHlerT T28LoHq7w7LWNMckyLRt9enlDt6Wvp4pa7Mxe6bbxumJKTMrllmfrpVvGuBUv37MiYxWJqRtP2b lsmqj7ejeIOhUEHee3Ovk9zODqd3VRJknSGt5enPncvTnSGN5D3LDrDaw2LNMR0uZKFJO4ML/coK2HN3Kzcxj/ 6U9/etz50eN6hz/96U Nc1jYoNWfuUx Ks5ZzSZkT5bpBq9Cy5EcM5NCsK328JaQ0hZleaT8Y1JlcjfIdmFTfeF1PI4LRS803uNke3jXSuy A7AFkwyrAuyFRa4u5Byu3O93eBKZHfcuGLL33r wDbrk7myK1qu8mQxZzUiY3F2gk0Spet6Y0PvP3dnRHtz2DqI93fdyhLOgg4w5//OMfG9Fvk0bK9hcs2 BqkzarlukYb3sLwDYE3hlex4Ow1QeDxUNnePPDIn01Kr9gtGxr42NneCmwkv/uqLMnIrF38 bNx50fPcYdbt682Ua3KWyzcHwuPFlYveZJ2ZNlumazXD1/w/KrFvywLxypWv0 vA2kcns2hp8HW/bYbfWnvHrEWyhuYa QpNVMt4R3Q4kLIddE5K4OvG5 Nswt7JbWzKRM3Fa30 pR30JO2g6utYdX9oRCaFLuzrysVvGuhSkftYWFJWmNpNvDW2i/1DTfdTuYQdTHuybu4Ag6yLjDbLV7dSMSrm2kcOrimK ubdCjQJd4yx4MHmZ7V kSb37UmI7MdLGwlvt6Y9mkYmd4C4cVM5lx/HITa uX6RcvbWzW3rcreX4Qd8hz0tQZef9Sm10OzrIny3RT6MpcN7m1VeGIXXiyKavaQGptNyhNlWALH 8c0rLUXLu8Rb6GOZb1CklYn3RLeDSUuhFwHztq6wLuWok0KlHXLtfdv20/kHvUt9Ljyk7dN6N28THt4pQ1r5S4rIBtpJN0q3jIU3KtlAZK77a/x2sMrsUhpGGxh15W5slZT6fp4XXEHd9BBxh329vaagrRJO7TyhL817X51epd4u3/q5yXoEi/dSDwLpYHDGNOeF9sj3sKnIM3TosRLDo2lZgcBWkviP/7xj487P3pc71A/Pm0R6PhoBeOt29lRsZEsOVLJdCONFz7jqWV6BpF/kx xW/3yP0mSNpBuCJbvaPbtaExrNXLaI968uFL6prqZ1U5LeDeUOA/ZMq/xj8DbCKVlwlk9ltxpvn pVxhjeAFXI8bIRnrUt9DjctwI0mzvdHt4pUlr5S6bxMpGGkm3inctTNm9Kc1TxUbQ5RtpD 9asIVdlzo5z6HyBtc8Ux9vadxhbdBBxh2uXr1aE0nV6tSf NXTtjuWZV6XeMt6nmVSqx 7xEtAyFNnfSnR3o1ksdcZ3rKnYN4VsCxs9mNneMlsmpqyuK1OUQqJunHjxuPOjx7jDjdu3Cjkoa WT1KtZ3y4jaLIny3QjSN1ODO/gIPdmIxLa7uGNI XtBsserAyWiLXu6LYV7xFvXlze7aKRPlbYSBt4N5e4EHKre6f3jrftDmyp3AbeDQerwvu3bUerD bwb9udZsjCjaT6k0qqb3RJe2Ys2kXs2m7T9JCKT2sO7CcwkmcnpQ9kjTLJXM90S3g3BFnZdqtvS jVwfb2ncoZISly9frlRee2Hg7UXB0WSWLKYdXBr6dkByj5foJe7wuL j47hDj8rKO1emezSpg0sPBymRCbwddKoeLwF9eyS/g0tD3w5I7vES0LdH8ju4dH19m4k7/Md//EcHaMO5BPCGo0UblkDfNlgNp80//OEPj4d0/OEPfwiH/FYtkXeuTLd60d4bHw5Sohp4e 9yrRoAfVult/fGoW/vErRqAPRtld7eG6 vbzNxhwsXLvTORZcGAG XbHd/LejbPeddXvEf//UnQ/vXJb09XkveuTLdo0kdXHo4SIlM4O2gU/V4CejbI/kdXBr6dkByj5eAvj2S38Gl6 trHj169PDhwwcPHhwcHNy/f//evXv7 /vz fzOnTu3b9 devWzZs3b9y4MZvNrl /fu3atatXr165cuXy5cuXLl3a3d29cOHCuXPndnCAATAABpQwMLSgwz/ 60 UKAMzwQAYAANgAAyAATAABuJkoJn1Djs7O mQDmNMmg7oX7Y72sAAD0neNJN3SP9W/RmAI9bcDOlxlB4eHgJvxAxA34jFTVPcv3HLC32hb1QM1H8eIe7g0yGGNw1H3CHmuAviDpHHXYYX aPEZ1tXWqe8H6IIOvLr0qmot9K3KmK7y0FeXXlWthb5VGdNVvr6 iDv4KI64Q TLH7LvwmMONFjoEHdA3CGu5R9Y7 DzXNNSp77fowUp2Qm8uvSqai30rcqYrvLQV5deVa2FvlUZQ9yhKmNZecQdIp VI 4Q1zTUeqNgeF//Dy6y5DOsq60Dv0etdBsZDn03okltIeirVrqNDIe G9GkthD0rSod4g5VGcvKtxd3MFvZnGi5Hda8fjVPs74jr/1xe2nMOGvZGLM1NukyIMwtxB2WJh2bOUEeG7M0W7UZbGxFRquz0vlK4XFIgYzMIisU0cjH4 68Qrz600iz9RtpC3BqaMDK2l916lZo9cCP9Q4 zzUtdeDnaVHKz07o68ebllrQV4tSfnZCXz/etNSqr29B3GG6SCZmlCSzZOMD 0o2MgXcoinaEOIODJWnaFshbSHRQtzBZEGHE0caTOihpWk4zRcJ8yDiDifkXX3wmDK3USWzpY12 rUBLOCIj7qDFh/Gxs77f43PV/uoAb3/cd3Fl6NsFy/1dA/r2x30XV4a VVm24w6zJDFmMjEGcQcHlZkX3 i31cvUjFcrHWjmEv96B/qadHuc8ThfHs3XwoHddNxhni12yASmZQ4Ug5g3fRXvLtnSrNT6NryNia9fm61Mw6kXhzP1ltS0A nh7ddsS4ONb2CzbCXBIMJukEXdwPL7UZ8HPUy hEwD0ddKjPhP6qpfQCQD6OulRn1lf3xNxh8ksoRkg4g7urtFs3GGZHr1wMB4fJXgCPs9e6bCP8d ik89WE/TiXPmbvf6yCF40vHcgsaDDQkkVZVt UWnbPt7KrHIUktt5EYrLwxPFbGJRLJdPU8LoJbqoRO9uMCCyzb56ztQ/zLAyRGkPztxMqz7PcIyp4WQTVysQ1c 8QQ2HFluIOPBmlVfhphrf4WOE9yuJpJX1e4W34y/qsZb5MUwmSMW utSZAoqL0Kv50rPbqVFMmcTutAKZAKVvPFyvoz8eoqApzxCuA8o1wa34JxB3cTzDdufX9Hl34gV eXXlWthb5VGdNVHvrq0quqtdC3KmNv4g4UdFhMR5NZgriDm8c2puHzbcMBCHfcIdsPYRUH4KgET bqzDRNWB U2MgGnRrJWG2zOasqCTZGFIyjH/zEkGXfgipl5q0iM1bL3x9biDtvZ/DKbiW6bcWqWm8cduOJq0qYj7kAz7sKvxY91Pfo/H3fgyesKb8NRguyqfvNZRy2aU3OUge3mMxIz5dIZmnQf37yt2NZKo1LeozFpRStLJwET41bcgal B3MH9wFmTC79nDUHKs6GvcgHXmA991xCkPBv6KhdwjfnQdw1Buew3cYfk EDcIceSfaKlaTjPo/NxB55W0xf82bRl9a03ufbp/E3MgqMS3pPufMXVtKXwm/ImTo5XExWCxOsdsl3qVqGE7eMvRYkUGXegikxB3m7vM 3HHVYTz22mj8IKq5NHMQW53kGGJ2QZrl4z0cY0nGaf27RIYxVrkXN2yl1hOYoAHMucfZRzcFlGt lAnverPTYceeBJNHZLXeJChDEnaTSVp0i2ryzKNpFsBzDhlQppLkGRMQcYdZHhClpEteKex3sF ZsX0GX5eTGrmsUDfPCcxnYG MamZxwJ985zEdKa vog7 PSH7uMO0rXPpuSrH7yQ6x0oHkGvL2RTtZoz0ZPVV9OWk6eaugDHDjiyIiMLdBV5htMEngBneuhY 70AkjlczaxlBcMcdtrLJuBmvFkrIWk1J0njcQc6yKaBg7XvgjjvIpQPK4g40g YgCk oJSM8m6a7mhd7cOiBCzSVWN3ATQdayHrSh Ex4OOXx7LXiRiGjDtQYIYp4DKNJBB38HmuaalT3 /RgpTsBF5delW1FvpWZUxXeeirS6 q1kLfqowh7lCVsax8v3GHbGuA1U4IHHeYr Y5W Zou4NsKtDUlHTVzmra0miLZB8HHXiBB693kGeomNz9YZ5hzawi5NriDrSWYTUVP1ry4Ig7zDOkW yvAmcwq4g40v5Rz8M3jDjRnPxaY8L6ZuTYzK2080JI3i4II28eTbp6Yy5I86bYSskwj6dUNfGxK Iy3mwwqkOQPOFzjeumXVn1eI8 GZpmxD3MHnuaalDvw8LUr52Ql9/XjTUgv6alHKz07o68ebllr19UXcwUfr7uMO/HU beKQzeKW2e6C8kjnquIOb4IOJ5cqZNOS48hK2XoHgj3fekMBE9RIxCWbojXS0FEjW9nvWWS/WEJbQlaKOxDWNAs9ZHpzIw1a2Pg0XHZLmebvvh3rHY7xUj8gvMHHHZZHO8K MdR6ycARdyDAvOqhcTGORommpvTcjoVw87gDAV515KPOwf2CG6 ZQNzB57mmpU59v0cLUrITeHXpVdVa6FuVMV3loa8uvapaC32rMoa4Q1XGsvI9xh34RyfT ZtJd7ZP4eonKeXuDw3Om7PZQYPNyd hkOsa6BJH803e3 F4xkaRBc61Qi9hxx14V8hltp1kWuk9i9UmlCY1y HEHehLc5rI0vS05jTUqr7qz01//U9TaDKdv8jnn5U87sVvAhMyaEirQbiWZW79j60AptgRmc7wZATBCkzwegdiiqihtKxVHy2Nzz4D u9I68HuUCreh2dB3Q6KUFoO SoXb0GzouyFRSotB36rCIe5QlbGsfOPTcJpxO/aVJPec/1qTbvrI0/lsqtbgt E0QWqwRcbJeI5mH J3NK0sCqvwWximaIuLBi1ser0DxxokLIpBkFCO9yxWE7vsdQxFcQc5d6TZNE1P bxjvQOXVBZ3IEhSYBky4Yk5UyDjDjQHVxZ3kAAINktHIB1xB34dgyoi7uDzGOI68HuYiigT0DdK WRkU9GUqokxA3yhlZVDQl6nYMIG4w4ZEnSjWb9yBf qB37PgRQM61jvwD37KSRq/W0ErGuZbZut4Jre9ikdQWIFyOQzBFIS93oGCC1vZdpLZZCxT0GzJ0JAj7sDhiYHEHXiJgLK4Q5r 9OOqbg2fWNAd3xB24pL64g1zCIKMs7riDDE8g7nDiyeL3AX6PH29aakFfLUr52Ql9/XjTUgv6alHKz07oW5U3xB2qMpaVbynu0OAX9s02lU0Omm3R0RrHHRxl2s5qYb2DjDKEls7kHdK/VX8G4Ig1x/4OPs81LSSfiYkAACAASURBVHXg52lRys9O6OvHm5Za0FeLUn52Ql8/3rTUqq9vQdwhqX7s7OxooawRO7uchrc9xd6kfcQdQosUNGsP4g6Rx12GF2hpZJzX0kh9P0ALUrI TeHXpVdVa6FuVMV3loa8uvapaC32rMqarfH19EXfwURxxhxaXP2C9Q4vkFkeZEHdA3CGu5R9Y7 DzXNNSp77fowUp2Qm8uvSqai30rcqYrvLQV5deVa2FvlUZQ9yhKmNZecQdOp8aN/sF/7rWsklY8RQ9yvOIOyDugLiDz5MgjDrwe8LQoS0roG9bzIbRLvQNQ4e2rIC bTEbRrvQt6oO5tGjRw8fPnzw4MHBwcH9 /fv3bu3v78/n8/v3Llz /btW7du3bx588aNG7PZ7Pr169euXbt69eqVK1cuX7586dKl3d3dCxcunDt3bmdnJ1vJiwMMgAEwA AbAABjoloFDHGAADIABMAAGwAAYCJuBxtY7/PD9t8P5Z4wZDtgfvv8WeOOWG/pC35gYGGB/rvqFg ry H5JtXxrjYe aylSXQD6qpZvrfHQdy1FqgvU1xdxB59wyQD92pimJWuxQN 1FKkuAH1Vy7fW AHqq9qPqWp8fb n6hX7LQ 8/fLf9tWhb9sM99s 9O2X/7avDn2rMoy4A IO6xkYoB /dm4TUwHoG5OaeSzQN89JTGdW w1VffQrLg8/T7F4G5gOfTcgSXER6KtYvA1Mh74bkKS4SH19EXdYP vOe6jw4/OcxHQG sakZh4L9M1zEtOZAeqr2Iupbnp9v6f6NfusAbx9st/ taFv xz3eQXo2yf77V8b lbl E3cYZEkZjTlzbAW01Gy8bGzs9Ov2/rBJw NeYuM//3P3/rh 4dszwd7R1mnjfly7z0 /8P33zpqUbHfZ1sbvHfamB/ ktZsW2/1vz8kjHmy0/eOnHRn1/67WlD0ByWe D98vtvzelfsvTGmA yDSwu8dXbw sAYqLD X3357OlM06ar43xoeX 0/hfRQfXvd9FB/eH77/9rd//dacfq9w4I0SL3dpd8IxrLU0Pld98KsuDz9PtXxrjYe aylSXQD6qpZvrfHQdy1FqgvU1/co7kBBh5ExyWKaJMloujDGzCZvohKJ8 g37kCzdDlt/v3Pj/Z9/GAv2xNRHj8chx4ctdinpDIdxx1Wjmlmsow70MyNcDks98NLjUuWuok7OIAMBC/3xijxOu6jKPE67qMo8WZBh NoL40ePGRFiZf7szvhGNbaG59V zFVja/v91S9Yr/lgbdf/tu OvRtm F 24e /fLf9tWhb1WGjyIL00VizCiZTZLjYzRdTIxJktnxCdf/PcYd2Ncnl5cm7RQp4K8fKet0tibC0JIBRy32KdlH7CzucPx9 FEEgJ34o 8VzVtffvKWw3JvvDR/4MUUzAAn2ljv4AASK97Tq2 GadENTU44QEYSxKQvd57C yhKvI77KD681miz ob/aHSN8v7l/uxOOIY1i7HNn0eOfkXGYH HNOoDfm3U8qbQF/rGxAD6c0xq5rHU17d0RcNklvDyh2Td0WPcIfPJTr/F38 z2/fD3nvkrnHUgD5SSUct8uTYR6Ql8R28Z8FXPH3amNPZUnwZd6DJ2xGopvGSB8xz4Lxj3UbcwS1Bf Hglq5nWq1dpmPNY8XKvtu6jKPE67qP48NJIywOv7N7ZK2yrhWYxjVcWwLKPjmGNHkAezyNHvyIz EHfI 0Yxnanv5 liA3h16VXVWuhblTFd5aGvLr2qWltf39K4g5nMVKx3sPw/6dtRmj1jcpTZ7ZMVZS06f/Rl1Cdvdba/Q7bY4fQvf//Je19 /5B2W5Bxh9OfPFxruTdemgNn8Y7VYW2Q8UO2ycXReyuStGbTlgQR4yWk2dIbsRFJrHjL7qMo8Tru o/jwHo02p83pn2dbw2T7lXzyZvec PD6DXdyWDti7HjrnM2fR45 RVYh7lDVc9JVvr6fB7whMwB9Q1anvm3Qtz6HIbcAfauqUxx3mMwSY8zmW0v2uN5BuoP85Sp9jUz fuVlxh2wKfbzFA9W1avEi4d eNr///mFncQcGwvZw3IHO5N D4JJ18HIjR1GH1X/WtdqOO7ANBCRuvBx3 OD00X6lseIlpPn7KEq83Ifz91GUeGl0lWCNMUO4f3mgXpvgLtHB Fz1wa 6PPw81fKtNR76rqVIdQHoq1q tcZD37UUqS5QX9 CuAMFHTbfVDJJkhDiDuzkcaBhk7hDvhaf WHvvbKvpFqdh7MBHHcgM8h5ZWeXi9XE /tsnUX2mx1f7mW/2cG7WsroTDd4GUjceElBWghAkKPEy/0zfx9FiddxH0WJl MOtF9J9P2ZB94NE9z/eVjzex45 hVbgvUOqt24tcbX9/PWXiKoAsAblByNGwN9G6c0qAahb1ByNG5MfX3tuEPVlQ7J6ug97sBOnnwZYe261sJa5B3SJJ8mD LJNcvW6mYdz3IGA8Mcfvv 20HI/vOy8UoJblpdrDy9fTpIcMV5mW3atKPE67qMo8bKy fsoSrwEiifV0fdnS1/3R8ewVsiY1WfkYGhdiFu2xufGfYuQG6zv94SMLm8b8OY5iekM9I1JzTwW6JvnJKYz0LeqmifiDv TzmZu/XpEcH/3GHdgVy1y6v15iR408Y/bhLEe5rBa9TGutH YlxNR4e/NwGVNgz5KmcLwAocxyP7y//eu3p8VGldw4X669/R34WpZwUeL9YO8Ez3KeFiVex30UJV7HfRQrXmPsDX1psI0SLz9W1ibKhrVWx eqD37V5eHnqZZvrfHQdy1FqgtAX9XyrTUe q6lSHWB vq iTtQ0EH lGay8dFv3OFo260s6JC9KcD/2P jCfzRFnenzQ/fP8zm0qsfFOCoBNdyzJfelGlzn0XL7B /9bapK3McqvihnhpAsw/nyF/iLRtvGVAosRLsw7mWa5LjxKv4z6KEq/jPooSrzXa0LhBX ZHiZcHw7WJsmHNYqzZ8Vm1H1PV Pp T9Ur9lseePvlv 2rQ9 2Ge63fejbL/9tXx36VmX4KO4wXSTGjDxWOiSro8e4A0/nrBUK9HU9ffMms i8uxZ7lvJLaT7Z3vf/dAnLPaWPvNGj23I/vOQBS5ZWP2nxJoLTxvqOMiDZBOb0L PDS/EjSTLFIGLVV94v8j6KGG/hfRQx3vxo8 Unb0WMV3bpsnTZsFbneVTYr6QB2N hqt jqzz8Wl16VbUW lZlTFd56KtLr6rWQt qjB3FHWixgzUpGhmTLKbJBkePcYe8T0Yo DWB1Rdxbx390tvxL1msrUVenZwvWX6e/Nhsmhx3/mKcbOBNJdda7of3g08eGnPMkvg9PILWRtyhDMgHe5eMeS8 vMTkCZ5XvTFWfeVNIe juPGe0Hd1H8WNN5tmn35P/o5m3Hhlry5Mlw1rNZ9H X4lr464Q1W/R1d5 LW69KpqLfStypiu8tBXl15VrYW VRl7855FUuPoMe4g3a/O0m3Mwzsz3uNCwOtBmqIq0FeRWB6mQl8P0hRVQdyhqt jqzz8Wl16VbUW lZlTFd56KtLr6rWQt qjCHu8OZtgs0dTfjxm3OlsST01aja5jZD38250lhygPpWffCrLg8/T7V8a42HvmspUl0A qqWb63x0HctRaoL1NcXcQfEHdYzMEA/XuN0y9tm6OtNnYqK0FeFTN5GYr2DajdurfH1/by1lwiqAPAGJUfjxkDfxikNqkHoG5QcjRtTX1/EHdbPuvPuIPz4PCcxnYG MamZxwJ985zEdGaA jbuW4TcYH2/J2R0eduAN89JTGegb0xq5rFA3zwnMZ2BvlXVNOdxgAEwAAbAABgAA2AADIABMAAGwAAYAANgoB0 GGlvvUDXgobr80Na1Aq/q7rrWeOi7liLVBaCvavnWGj80ffH90touoboA9FUt31rjoe9ailQXgL6q5VtrfH19EXdYS3JBga H5ecBb0AkiOgV9IxKzAAr0LSAlolND07e 36NLfODVpVdVa6FvVcZ0lYe uvSqai30rcoY4g5VGcvKD83PA16fXqKnDvTVo5WPpdDXhzU9dYamL/w8PX3Tx1Lo68OanjrQV49WPpZCXx/W9NSpr6959OjRw4cPHzx4cHBwcP/ /Xv37u3v78/n8zt37ty ffvWrVs3b968cePGbDa7fv36tWvXrl69euXKlcuXL1 6dGl3d/fChQvnzp3b2dkxOMAAGAADYAAMgIHOGTjEAQbAABgAA2AADICBsBnAegefKNPQvl8CXp9eoqcO9 NWjlY l0NeHNT11hqZv/e9b9GibWQq8uvSqai30rcqYrvLQV5deVa2FvlUZQ9yhKmNZ aH5ecDr00v01IG erTysRT6 rCmp87Q9IWfp6dv lgKfX1Y01MH urRysdS6OvDmp469fVF3MFH7aH5ecDr00v01IG erTysRT6 rCmp87Q9K3v9 jRNrMUeHXpVdVa6FuVMV3loa8uvapaC32rMoa4Q1XGsvJD8/OA16eX6KkDffVo5WMp9PVhTU doekLP09P3/SxFPr6sKanDvTVo5WPpdDXhzU9derra8xoyntgLaajpOgwk9l0ZJJkUZSZndvZ2UmHdMTn5423l 9QNxsaky21LzIjxZtDmW8PBOxB9WVCzNd8emzRd8hntccPtZbplxmk6l4i25lkw1BgzNH0lCZyO b7xiaIWJoeGt7/cU0hjsSeANVppGDIO jdAYbCPQN1hpGjEM lal0YyMSRbTJElG04UxZjaxV0BMZokxBnEHyWxkft54e7llDM1ktuZpfuoSH17GSBM2K/QQH95B6cu3KokbU9xhni222mI1Cam8Z2WaeYisPzOusgTwljETx3n4eXHoWIYC pYxE8d56BuHjmUooG8ZM3Gcr6 vSWaT5PgYTRcTY5JkdnwiSxkzQdzB6i4x bU0k1lujwnjMk3NeHu ZSTkmPDmAZqtecR4h6Yv91sCboyJJu7Aixpk3IH6M9 /2WqOqPsz6 tIxDReOWBy1tDw1vd7mDoVCeBVIZO3kdDXmzoVFaGvCpm8jYS Vak7sbphMkt4 UOyOkbTxXRkzGSK9Q6S2Yj9vPy0XPu6dClculpwbwVWBjVPi15flnu8vdweG7O1HUfcgYIOy 3x1jyVcYftZWrMWC7YkcuXiI2IxyuWWyaAV7IRXxp XnyaSkTQV7IRXxr6xqepRAR9JRvxpevreyLuYCYzud5hukhGZpQsptjfweo6Efu14 0lv4PAqCPDKzEO4T0L1jFNU4mdz0emb5qm28t0bMbpcju /R3ycQdCympaBSKLGzJMRyK /uwAO0B96/s9bj5DywXe0BRp1h7o2yyfobUGfUNTpFl7oG9VPt/EHWgfB95acpEkZrXaIUkSxB0sWqP0a3kVt1yzTcDjw8tg80GWWP14hhy9vvLVg jjDvkNHfJn4rt/rQHZ gi8FiGRfYSfF5mgFhzoaxES2UfoG5mgFhzoaxES2cf6 h7FHSjoIDeVpDcs6DcsEHew k3Efi3N2ayl6ZHhNVtzXqlOy9StqXhkeGXvHYK 9IYF/YYF4g6xxtFkr7bSEd /FlL6ODS89f2eQhqDPQm8wUrTiGHQtxEag20E gYrTSOGQd qNGZxB2ulQ5Ik/IZFsjoQd7BojdvPi/v7UrwPH72 8r2D6OMO/EYJj1F4zyLu8ZmF5sTQ8MLPY mjTEDfKGVlUNCXqYgyAX2jlJVB1dc3e5fCGMOvVySrg07SD8LLv/LHL6gk/d3Z2UmHdMTt5 Vn5jHhzc 682diwpu/L PWd7y9lEMWp XOi6r1tcIKeTWxr6RqffM37NozQ8Nb3 9ZS2lQBYA3KDkaNwb6Nk5pUA1C36DkaNwY6FuV0swtL4smJMcH1jtYtMbk5 XnLdbEJrJ12sAbt772rbo1t14a0t6fLfnkZhaEfVC/z2LJfcSAOfEzwIVlYjoZ0/NoE13g523Ckt4y0FevdptYDn03YUlvGeirV7tNLK vr73SISk6EHewxIjMz5Nr0fPTGO3zNEu7DM7A9ncYmr5ScYmdz6u f624Q5qmcsGOTMeBl1FsnlCt7 YwueTQ8Nb3e5g6FQngVSGTt5HQ15s6FRWhrwqZvI2EvlWp42XIR4mRMclimpw8EHewaI3PzzNbc 4KckU6AY8br7WpZHxxFgq1DEpfvmGHEHegn0clfYfz ywscT4R33iVxyjPDA0v/Dypfnxp6BufphIR9JVsxJeGvvFpKhHV1/fN72gmNQ7s7yBViS89NL8WeOPrwxIR9JVsxJeGvvFpKhHV93tka GngTd8jepYCH3rsBd XegbvkZ1LIS VdlD3KEqY1l5 LU rOmpA331aOVjKfT1YU1PHeirRysfS Hn bCmpw701aOVj6XQ14c1PXWgrx6tfCytry/iDj68w6/1YU1PHeirRysfS6GvD2t66kBfPVr5WFrf7/G5an91gLc/7ru4MvTtguX rgF9 O iytD36osm0ePHj18 PDBgwcHBwf379 /d /e/v7 fD6/c fO7du3b926dfPmzRs3bsxms vXr1 7du3q1atXrly5fPnypUuXdnd3L1y4cO7cuZ2dHX57HAkwAAbAABgAA2CgMwYOcYABMAAGwAAYAA NgIGwGsN6haqQmK4/v03xY01NngPq 2L87nH8D1FfPzdeApdC3ARIDbgLfLwUsTgOmQd8GSAy4CegbsDgNmAZ9GyAx4Cbq64u4g4 88Gt9WNNTZ4D6Difo8GL/7gD11XPzNWAp9G2AxICbqO/3BAyuwDTgLSAlolPQNyIxC6BA3wJSIjoFfauKibhDVcay8vBrfVjTU2eA iLuoKd7VrZ0gP25MkeaKwxNX/h5mnvretuh73qONJeAvprVW2879F3PkeYS9fVF3MFH/6H5ecDr00v01DHGIO6gR67KluL rUyZqgpD07e 36NK3hR4delV1VroW5UxXeWhry69qloLfasyZsxoyntfLaaj5PiYJYkxE84yxswmpUGKnZ2dqhd WXV6pnzfeXpKgY2PS5XZegu1lumXGaTq3spTitVBs/jF8vIVKOfTdmmeLdIwxhdKHHHf48YcXyfIfG/Pi4oeF8RHzzq9/9SPzYv8i57prBavvMk3NeJvwGmOW22PutH5ZVD1YvIyu2UT4eAvvX8dN6sgKef2do9OmaeoA5ch K06Dn4X6DsF68fOearfn22KTpks84QDmyQtZ3nq113eLx2Rgz3zIR403TdHuZrryGDLQEG9/9y31S6ps9SuZbJDEXyDtRjqyQ 3OapjxeSaRDwFtJRBX6NuhUtI3XjIxJFtMkSUbThQwuTBfJyIwoK1l3IO5AN2rIf83WnO80epbw eEpm0zN1yxjEHQKftxQqNd5esnZb85S1Jv AP1pZJH2wcYcff3jx/Wwtxq9f7N99/zd3C0MP7/8m269Bxh3MO7/mkr 6eNeYH734zTsckgh2fweapLFS5BCQq eXxcNR4P2Z7WwqETjewvtX3pgyveH92xR1Dbbj6LRuUBK TLNtwX6/5DcIS4wyHT5etpD8VBl3kEBk2i09NRisvtvLdGzGhd/ZSIwyrRrv1jxlTWnU4tCDxCjTqvFyf05XTrAxW3HjHW8v2d gW5gnBVJTmVatr2MSJDHKtBa8DToVEr5M891Rf3w2yWySHB j6WJiTJLMkiSZzBJOH eX/o 4Qxr2QZ1Sfn063l7yE4VuLYry8txVAgrcj5emNpIOGS9HIqVSlr7k8cspq5TebM35aUp0hRl3uJ JtAPnO5x/ iEIGn /fNT/68Mo7J14JoTIy7mDVerF/98cfXpRRiWDjDvloIE9j/LL4Xgi5P7ORDSZCxlt4/9INW3iTOrKYsTDxOjqtA5Qji/HW93u4qQYTfoOwXrxMHQE3xrBH4QDlyOIGw9SX3CT52GWDHaAcWVw9TLx5y/l5lM9ip8KRFTheNo8SDDZdreExK4 Zy0SAl5SSruAmoPTqa43PtNaDhiwHKEcWd4be798GnYpu8J54dWIyS TyB8eLFcnJA3EH7oJhJvJRK3mGeu1ye7w1Twsfq2H6te1RHSzetUoRJzR20BPF4f0zgWHGHeQKh Rf7dwvjDhRTMO98yJGF/LKI/Jlg9WVFKCFv0jpZWvBaGL0/Bou37P513KSOLOYnWLxsISW4PztAObK4td79PLbEkdhwEI4AL32HYba2Oe7gAOXIYjKD1Xe8vZT zNDbYAcqRxdXDxOtY3OEA5cgKHC bx2 XcCDYAcqRxQ2Gqa8coMhUjjs4QDmyAsfLTx 2k884QDmyuJ1 9W3WqegG74m4g5nMeI2DmcxGoxG/6SS3fkhyB IO3AXDTPANxuZRZ VVVXQecQfiIXw/vkwpsl8un8t7D/m6KuIOP/7wIr89QSGJX128 2PzoxcXP5T7O SjDPQihnzVInx9j/phtsyz4L2n7JX Klla8BLq n/Dx2vdg46b1JHFRIWP1 rPDlCOLMbbr5/HZrgTGw7C2vGy/XJ/Bz7JFHGHd2Rx4WD1zdZpj8fsFct5qfX RQR4CcI8nfOWFnHj5e6Xf7w6Oq0jixsMtj/LMUrOCBygHFmB43VMghygHFmh4eUxhwxzWO6X1SDeN3GHySwxxlB8gTaVnI5MkiyS1WEmM0foAX EHliTMRGEQK/NWj7fMIbOtjstYtPi1bHDNRPh4y5Sih4fckrBwtOWX oiowOMOFDgwxvA7F7z8gc7IuEN QwfaY1Jd3IHD2PnOXDUr/P6cx1jnTPh4rfvXcZM6spii8PHyq3w0dXGAcmQx3mD9eLKw0iCsGq9clCvjDg5QjqzA9aV12rym g2anEfdn2mCIA9/y63GHiI6swPVl8/IL8h2gHFncYMjjFQ9W0id0gHJkBY7XMQlygHJkhYa3EaeiG7xHcQcKOjherHBv94C4A3fBYBP5L VUybxVxhyLBwvfjrSHGAkEuAnlIm4wjgccd5P4O/D6F3LVBxh2y7Rty 0pmAMXWkir0ze8fTiqTo1C43LcsK3y8Vgeu TF8vNb967hJHVnMkgq8sj87QDmyGG/IfjwbueEgrBqv3CUq rgDK8sJvosdIjqyuJ0w 7P8MpxMjRsvy7GJZFyGE47qYeprLeugaXnEcTTCy EVwps9OudbDhEdWax4IPry7cl3K4O1zjhAObIaxJvFHeRKh6TkmC4SY0ZyE0pZEHEHliTkhNma8 aR83Q NlvWzsxWx2Us4fu1bGojifDxlinF8Hn4cCyp4sIq4g7yJy34DQsKSVhxBwo9UFd/35gr 7/ sXlH/gZn4PpS IAXtbJM1pfG8rw7K3C8FpD6H8PHa92/jpvUkcVEBY43358doBxZjDcQP4/tKUtsMgjrxWtZLuMOVpbckdGRxTRq0Ze/QXWAcmQFjldurEimxo2X5ZA9mYHH9x4Nq8nAWXFHp3VkcTsh37 FkyAHKEdWaHgbcSq6wWvo5zMd71Akq8P9s5qIO3AX1JIo 61XXlYngQTu10pTG0mHj9caYvKo aHCCS7DTxc oyXuwO9Q0KsT/J4tJ SiBt6W8lcX775vfkQ/xnkUp8g2TQj0oNWthUEHv6wszB8w3jZkCB vdf86blJHFlMXMt7CTusA5chivCH7tWwk706XzrccoBxZ3FSYeElZHns5ESteloMT7KM7RHRkcT th6muNUdSfafrtAOXIChwvmZd/yULeyAyBnSi9eDkqyqD4jAOUI4vbCbM/s3mc4EmQA5Qji9sJBK91wzos98tqEG/2sMivYsivbsB7Fkx6HH68XCHJ0KyOy dD9mvZyAYT4eO1lMqPI1xAvoJLFPGuxcxYmHEHjjJwBOH939x93xgZQShb78BVFP2OJv2wU9b3T r79RDKRl18160hxxB24r4eR4NuTzHHcpI4shhLseFXWaR2gHFmMNxA/j 2hhN8grBevBV9 S wA5cjiBqEvU9Fjgmbg8onDo5ZDREcWYwlTXzIvfxfH juaeaRD0Jc7YUy/o0mgWD766LgT/bKYuvr379FGkknuMJOZ3O4B 0oy6RrjDvQI4XfCOa4pQcnFkNb5YP1ay86mPoaP1xpi6NU13vLKGlak3DLNdIUZd6DXJXhDB/odTbm1JAcX5HsWV/bvGvPOlXcM5eZ/3iJrNsh5OPkBhSsd/LKkvpweQiJMfSXz ftX3pgyTcMyv6hpZVGbYeJ1dFo3KIlRppnA n4PN9VswjH3lkBk2k0FmRcsXsmexO4GJeHLNLcWLF4rZG 25jxcSyAy7aYicH3lt1ObOxUSvkyHr68lFhtsnbdAyY8yzdVD7s 8wNkariUQmXZTEXJ/dk CJEaZVoS3KadCwpfpBvszL447SoyMSRbTZHWYyYyz82siqAz9xXsWafAH3XUkKHuxltX5jksFwv RrLeMb/Bg 3kKl NW1zP6T35nzmthC6YONO8idGjIjxd6QHHSwwhMv9u9S6IG6uvXTm1QrTH1ZIx51jTGkl18W3xFh 4mXzGk Ej7fw/mWV8zepIyvYODjbnO/PpDgXqIo3WD e4r Md/NB2EFFmqYh4 Wb14o78OotHsS4pDsrcLx D1m9 tLmLNSlOcgS8f3LL1DI7hoxXtmfo9fXPQly3KSOrHDGqwadirbxvvkdzaTGgbhDfpCK6Uz4fnyz bA8Qr5zGR58eoL7N3iCBtwZ9Axeopnkq5uE1McrqwCvZiC8NfePTVCKCvpKN NLQt6qmiDtUZSwrD7/WhzU9dQaob/SxBglwgPrqufkasBT6NkBiwE3AzwtYnAZMg74NkBhwE9A3YHEaMA36NkBiwE3U1xdxBx954df6s KanzgD1ldPy6NMD1FfPzdeApdC3ARIDbqK 3xMwuALTgLeAlIhOQd IxCyAAn0LSInoFPStKqZ59OjRw4cPHzx4cHBwcu3i5gAACS9JREFUcP/ /Xv37u3v78/n8zt37ty ffvWrVs3b968cePGbDa7fv36tWvXrl69euXKlcuXL1 6dGl3d/fChQvnzp3b2dnhdxqRAANgAAyAATAABjpj4BAHGAADYAAMgAEwAAbCZgDrHapGarLy D7NhzU9daCvHq18LIW PqzpqQN99WjlYym X/JhTU8d6KtHKx9Loa8Pa3rqQF89WvlYWl9fxB18eIdf68OanjrQV49WPpZCXx/W9NSBvnq08rG0vt/jc9X 6gBvf9x3cWXo2wXL/V0D vbHfRdXhr5VWUbcoSpjWXn4tT6s6akDffVo5WMp9PVhTU8d6KtHKx9L4ef5sKanDvTVo5WPpdDX hzU9daCvHq18LK2vL IOPrzDr/VhTU8d6KtHKx9Loa8Pa3rqQF89WvlYWt/v8blqf3WAtz/uu7gy9O2C5f6uAX37476LK0PfqiwbM5ry3leL6SgRx3SRGDOi3NnEFaHY2dmpemHV5eHXqpZvrf HQdy1FqgtAX9XyrTUe q6lSHUB Hmq5VtrPPRdS5HqAtBXtXxrjYe aylSXaC vllcIVlMkyQZTRfGGI4vTGbJdGSSZJEkySxJjJlwVpI7EHdQ3Y3WGg8/fi1FqgtAX9XyrTUe q6lSHWBoelb3 /RJTfw6tKrqrXQtypjuspDX116VbUW lZlzCSzSXJ8jKaLiTFJMlskiRlN5fIHzjoue J/xB3SqI h bXAG3V3xv4sccsLfSPXF35e3AJDX gbEwPozzGpmccCffOcuM ceHtiMkto cN0kYzMiNZBJBsciDu4Wdaei3m4dgXd9kNfNz/ac6GvdgXd9g9NX/h57v6gPRf6alfQbT/0dfOjPRf6alfQbX99fU/EHVbvUmTrHSazZGLMLJkZM6H9HeTahyR3IO7g1kl77tD8WuDV3mPd9kNfNz/ac6GvdgXd9tf3e9zth5YLvKEp0qw90LdZPkNrDfqGpkiz9kDfqny iTtMZokxhuILtNcDvXORrPZ4MKMp9ndgcuHXMhVRJqBvlLIyKOjLVESZgL5Rysqg4OcxFVEmoG UsjIo6MtURJmAvlHKyqDq63sUd6CgA0cWRtMF7zeZrA5aAbHaYpJOnPiL9Q5p1Af8 KjlxfvwccsLfaFvVAzU93t00QG8uvSqai30rcqYrvLQV5deVa2FvlUZy IOcqVDsjryu0jSb2rKTSipJP1F3CGN kDcIWp5MS NW17oC32jYgB XlRy5sBA3xwlUZ2AvlHJmQMDfXOURHWivr7Zz1bw6xXJ8ZFf3eDeaRJxh6i6VQ4M4g45SqI6AX2 jkjMHBvrmKInqxND0re/36JIfeHXpVdVa6FuVMV3loa8uvapaC32rMpbtGplfxTBLEmMm8nw EpGIA3GHqrzrKj80vxZ4dfXPqtZC36qM6SoPfXXpVdVa HlVGdNVHvrq0quqtdC3KmO6ykNfXXpVtba vkcbSSa5YzRdTEdmtadkskiSbF3EdJQrdXQCcYc06gN fNTyYh1 3PJCX gbFQP1/R5ddACvLr2qWgt9qzKmqzz01aVXVWuhb1XG6Fcy3/yV20nSvg/4Hc08p5iH5zmJ6Qz0jUnNPBbom ckpjPQNyY181jg5 U5iekM9I1JzTwW6JvnJKYz0DcmNfNY6uv75nc0kxoH1jvktYnpDPz4mNTMY4G eU5iOgN9Y1Izj2Vo tb3e/IchnwGeENWp75t0Lc hyG3AH1DVqe bdC3KoeIO1RlLCs/ND8PeH16iZ460FePVj6WQl8f1vTUGZq 8PP09E0fS6GvD2t66kBfPVr5WAp9fVjTU6e vog7 Kg9ND8PeH16iZ460FePVj6WQl8f1vTUGZq 9f0ePdpmlgKvLr2qWgt9qzKmqzz01aVXVWuhb1XGzKNHjx4 fPjgwYODg4P79 /fu3dvf39/Pp/fuXPn9u3bt27dunnz5o0bN2az2fXr169du3b16tUrV65cvnz50qVLu7u7Fy5cOHfu3M7OzpstIp ACA2AADIABMAAGumLgEAcYAANgAAyAATAABsJmAOsdqkZqsvJD 34JeH16iZ460FePVj6WQl8f1vTUGZq H5JT9/0sRT6 rCmpw701aOVj6XQ14c1PXXq64u4g4/aQ/PzgNenl ipA331aOVjKfT1YU1PnaHpW9/v0aNtZinw6tKrqrXQtypjuspDX116VbUW lZlDHGHqoxl5Yfm5wGvTy/RUwf66tHKx1Lo68OanjpD0xd np6 6WMp9PVhTU8d6KtHKx9Loa8Pa3rq1NcXcQcftYfm5wGvTy/RUwf66tHKx1Lo68OanjpD07e 36NH28xS4NWlV1VroW9VxnSVh7669KpqLfStypgxoylvfbWYjpLVMZklfFImktmEClh/d3Z20iEdQ/PzgDeO3r29TLfMOE3nFhzoaxES2UfoG5mgFpyh6Qs/z oAkX2EvpEJasGBvhYhkX2EvpEJasGpr68ZGZMspkmSjKYLY8xsUrACYpYkxkwKs5LVgbiDJUxkH 4fm10aJd569H7S1ZQziDlHq6xhzgNdBTgRZQ9O3vt jS3Tg1aVXVWuhb1XGdJWHvrr0qmot9K3KmJFLGEbTxcSYJJklJ4 y81wKcYeqvOsqPzS/Nj68W/NsUxJjDOIO2J9F1 DjYW1896 bhKHhhZ/n7g/ac6GvdgXd9kNfNz/ac6GvdgXd9tfX98Tqhsks4eUPyfExXSTGjPgVjOPTJ/5H3CGN hiaXxsZXgo6LLfHW/MUcQfEHaIeqzJwkd2/a/UaGt76fs9aSoMqALxBydG4MdC3cUqDahD6BiVH48ZA36qUnog7rN6lsNc7FJ5MTh6IO1TlXVf5o fm1seJF3IHuu1j1LRtVgLeMmTjOD01f Hlx9NsyFNC3jJk4zkPfOHQsQwF9y5iJ43x9fd/EHWgvSWtdA 3sYJ1McgfiDnH0pzIUQ/NrY8WLuAP18Fj1xf0Lfcv6QEzn6/s9utgAXl16VbUW lZlTFd56KtLr6rWQt qjB3FHSjokN85svDNiyR3IO5QlXdd5TFP06VXmbWIOxAz6M9lPSSO89A3Dh3LUMDPK2MmjvPQNw 4dy1BA3zJm4jgPfePQsQxFfX3/P5jUIyvqz6JeAAAAAElFTkSuQmCC
91 < 100 so no color
0 so no color
130 > 100 and < 200 so magenta ????
349 > 300 and < 400 so red?
222 > 200 and < 300 so green???
If I wanted to raise the abstraction level ...
1. row specific set of 10 numbers each mapping to a color
2. for each non-blank cell in the data, use the row-specific ranges to get the color for that cell
Paul_Hossler
07-02-2025, 11:34 AM
Going way out a limb aqnd take a WAG ...
see if this is close.
It's my best guess and what you're wanting to do
k0st4din
07-02-2025, 01:45 PM
Hello, I just tried the table but it's not like that. That's why I'm uploading another table in which I've shown (figuratively speaking, real numbers) how things and colors should happen.
This test checks absolutely the entire range, and I said at the beginning that the check should start from the cells that I colored in brown (at least for me it's brown).
The other thing is that in the macro, I don't see anywhere (and this is most likely because it's not working correctly) where I personally can write exactly from which cell to the right it should start calculating.
In the table that I'm going to upload, please take a look (because I didn't do it for all rows), but these: S5 - and to the right after that, Q6- and to the right after that, M8 - and to the right after that, T9- and to the right after that, P10- and to the right after that, A34 - and to the right after that.
I made them colored up to a maximum of 4 colors so as not to make them all 10 colors, but the logic is clear.
The question is, somewhere in the macro, I can write down exactly which cell in the row to start calculating and coloring, and not have everyone start from column A. This first
Secondly, there is no need for the cell from which the comparison is made to be colored in a certain color
You say it takes it from the brown cell to the right, but in your macro it doesn't do it correctly.
For example: It should start from N12 - to the right, and it colors the entire row from A12, where it meets the requirement and reaches the specific numbers, for N16- it's also not true, again it colors the entire row. From C16 to the right.
"What are the colors in P1:Y1 for?"
The colors are just for my help and convenience, they don't do any other work. Kind of like Notes (hint, reminder)
Maybe I'm confusing you something. This brown cell is just for reference, from where exactly on a specific row the calculation and coloring should start. This is missing in the macro and I won't be able to say where to start checking. The idea is not to capture the entire range and check everywhere. I need to be able to record in the macro from where, to where.
Paul_Hossler
07-02-2025, 03:14 PM
It's not brown in my palette, and I didn't realize that you manually marked them brown
This is version better (I think) but check some of your colors you sent. I think you missed some when I compared the macro against your workbook
Screen shot is marco
32089
k0st4din
07-03-2025, 12:36 AM
Hi,
I tried the new version, but I think it gives me an error like last time because I'm using Office 2007.
Can we add this option like before so it can work in all versions
' 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 Val(Application.Version) > 12 Then
'If Application.Version > 12 Then
I downloaded your file and just made a button so that when I press it, I can activate the macro, however, what happens to me is that it just deletes all the
coloring and everything is without colors, it's just a simple table.
32094
What I call brown, now I see exactly what I chose arbitrarily, isn't the problem with the color, and from here it can't color the specific cells? I'm attaching a
picture -> "table1.jpg"
32095
That's it for now.
let's see where the problem comes from and then I have a few more questions.
One of which is if we can tell the macro to do this coloring in specific worksheets like it was done with Array ("Peaches", "Tomatoes", "London City")
Paul_Hossler
07-03-2025, 07:14 AM
The xlRgbColor enums were added in Excel 2013, The old version check was for conditional formatting, I changed to just use .Color which should work in all versions
Doing all sheets was more complicated
I added a Parm sheet with the value ranges (1 - 9) in col A, and colors (row 1) for all sheets. The .Color in row 1 for each bracket determins to color for the data cell
I added a 'signature' in A1 of the sheets to process = "Index#" as a test to see if that sheet need processing
On a data sheet, blank index does not process that row
Your command button is on Parm sheet
It was easier to do it this way
k0st4din
07-03-2025, 02:57 PM
Hi Paul,
what you did is great, maybe incredible, but with these changes you made, it's a total mess in my head and it's totally incomprehensible to me, which won't help me in the future, or even now.
This Index that you made cannot exist, because my range will be radically different and will be moved somewhere around the middle of my original table. The second thing is that nowhere can I describe which worksheets this calculation and coloring should apply to, because in the workbook I have 70 worksheets, and I only want this calculation to be done in 28.
The third thing is that when the values are exported in a separate worksheet, I completely lose track of which values, which row they apply to and I can make a huge mistake in the calculations.
It should not differ with such huge changes, but be a maximum of 99% to my table and the example I gave.
Last but not least, I downloaded the file and you sent it to me with already colored cells.
According to your description, I went to the separate worksheet - I pressed the button and everything disappeared and became in each worksheet as a regular table.
If you want, I will record a video so that you can see that something is rattling and breaking somewhere.
Something very important, if the previous macro can work in any worksheet (a kind of active worksheet (I'll just click 28 times (no problem)), then let's think about how to fix it there, but also to be able to first define the range from where this calculation should start and from where to where to do these formatting. If this brown one of mine can remain, which is actually some red (as I showed in the picture), it will be great, it is like that now at least in your table.
Please, take another look at the macro that you made and I uploaded when I asked, how there are ranges set from where and what exactly the macro should do. My request is if it can be like that here too.
You may ask why?
Because I have uploaded an accurate, but very small example of this entire table(s) that are only in one worksheet.
That's why I need ranges that I can define.
If you want, I will also make a video so you can see what It's happening and I'll send it wherever you want or via YouTube.
Paul_Hossler
07-03-2025, 03:41 PM
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
k0st4din
07-03-2025, 09:44 PM
Hello, a little later I will try the macro and write, because I have a little problem with the baby. What is bolded by you, are as I wrote the values at the end of the table. And why do I want this range, where to do the coloring - because the table has many rows and columns (past years, Which are in the database, but I don't look at them I don't need coloring for them, it is already saved and stays in the history). I just move to the right, and start new columns for tracking and calculation. I strongly hope that this macro can do, what we are writing about and trying to achieve, to track again in this (given) range but as I wrote already to start the coloring from a precisely selected cell of each row and to the right.
k0st4din
07-04-2025, 12:03 AM
Hi Paul,
I did the test by changing the range of cells in the test table and where to take and do the comparisons and coloring.
So, I'm afraid we're back to the original situation.
1. To work and execute the same macro in specific worksheets, this doesn't work, we need to see why.
2. The idea was to start coloring after the "brown" cell of each row in the range that is defined.
At the moment, the macro works like the old one - that wasn't the idea at all.
Your penultimate one started calculating, tracking and coloring, exactly as it should, we just had to finalize it.
I'll upload the table again with more explanation.
It should do the check in the example that is in the range A3:AA37 (I'll then change the ranges with my real ones).
But this check in this range A3:AA37 should always start after the Orange cell (I've changed it now) and to the right until the end of the year (as in the example table it ends in column AA.
From AB:AK are the increasing numbers according to which the color changes.
In the real table, the rows and columns will be completely different, the idea is to get the correct results and colorings during the test.
I remain at your disposal and with thousands of thanks!
The idea is to have this range definition in the macro again, as in the old one, so that I can change them, but in the given range, it should start on every row to the right after the orange (brown) cell.
Paul_Hossler
07-04-2025, 08:04 AM
I think you're fighting Excel
It should not be necessary to hard code ranges, etc.
Anyway, here's my latest attempt
I copied BG 2 times since BH and BJ did not have any Brown cells and then ran the color macro on a WS loop
As far as I can tell it woks
k0st4din
07-07-2025, 01:03 AM
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
07-07-2025, 04:49 AM
Ver 8
k0st4din
07-07-2025, 12:45 PM
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
07-07-2025, 01:17 PM
<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
07-07-2025, 04:06 PM
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
07-08-2025, 03:23 AM
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.
321103211132112
Paul_Hossler
07-08-2025, 11:30 AM
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
07-08-2025, 10:58 PM
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
07-09-2025, 04:17 AM
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
32115
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
07-09-2025, 07:05 AM
I tested the macro and it showed me the same as yours.
32116
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
07-09-2025, 07:34 AM
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
32117
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
32118
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 :crying:
k0st4din
07-10-2025, 01:42 AM
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
07-10-2025, 08:26 AM
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
07-11-2025, 12:28 PM
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
07-11-2025, 03:15 PM
Glad
Feel free to come back if you want something else
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.