conditional formatting to be macro on specific rows and colums

[k0st4din]

Hello, everyone.
I would like to ask for your help because with conditional formatting I am doing it but it is very difficult to do it for 40 worksheets.
The idea I will attach in a table is:
In a given cell I have some value (number), at the end of the table I have some constant numbers.
I'm trying a macro where I can tell exactly which worksheets (Array (peaches, bananas, paris, etc.) and in exactly specified cells to compare and if it's: greater than or equal to color the cells.
just for Example:
In cell A75, for example, I have 1,500.
Values are 100, 200, 300, 400, 500, 600, etc.
1500+100
1500+200
1500+300 ect.
The check should be done in the cells described by me on this same row A75, for example in cells C75, G75, M75, Q75, etc.
I will also attach a table.
Thank you in advance for your assistance.
row color cells.xlsm

[Aussiebear]

Excel already has this feature. are you sure you wish to re-invent the wheel? Have a look here. https://answers.microsoft.com/en-us/...6-64660f0a5b2f

[k0st4din]

Hello, to be honest, I have hot water, but I don't want to bathe under a tap, but with a shower. As I wrote above, I know how to do it with conditional formatting. I mark exactly the cells I want, then I say from which cell the number should be followed and if 1500+100 and if it finds a value greater than or equal to color it in the color I want. Then 1500+200 in another color and so on until it reaches the last value I set. Thank you very much for the link, but it doesn't say anything about macros, actually this about coyote, I'm asking for help. Because I have to make over 29 worksheets and with a macro it would be many times faster. Thanks again! Be alive and healthy!

[georgiboy]

If you don't mind me asking, why do you use two accounts?

You have started the thread with one and replied with another, this could get confusing.

[Aussiebear]

The link shows you how to create a conditional format. All you have to do is record a macro using those steps, then bring it back here if it doesn't work correctly and we can try to adjust it where necessary.

[p45cal]

In your attached workbook, in Sheet1:
Put the macro below into a standard code-module.
Make sure Sheet1 is the active sheet
Run the macro.

Sub blah()
totRow = 10
Base = Range("A" & totRow).Value
Set HighlightCells = Intersect(Rows(totRow), Range("B:B,E:E,H:H,K:K,N:N,Q:Q,T:T,W:W,Z:Z,AC:AC,AF:AF,AI:AI"))
Set adds = Intersect(Rows(totRow), Range("AJ:AQ"))
For Each cll In HighlightCells.Cells
  For i = adds.Count To 1 Step -1
    Set v = adds.Cells(i)
    If cll.Value >= Base + v.Value Then
      v.Offset(1).Copy
      cll.PasteSpecial Paste:=xlPasteFormats
      Exit For
    End If
  Next i
Next cll
Application.CutCopyMode = False
End Sub

Lots of hard coding, lots of assumptions. It's a start. Let's see if it's doing the right thing first.

[k0st4din]

Hello, to be honest, it turned out that a long time ago, something happened and with the first account I could not log in, and then I made a second one. Since I am writing from two different places, the password of one was saved in one, and the other account in the other place. As for your question Why, it's because I first asked if the already perfectly working macro could Just be added, instead of running it separately in each sheet, with the push to do it in all the ones I specified. After which, as a P.S., I asked if it could, with some minimal change, do all this, but in certain selected cells, and not on the entire row. However, after that I thought that it's not right and I'd better ask it as a separate question, because the macro implementation is different, Yes it has a fairly close meaning, but still different. I didn't do it with any bad intention, on the contrary, I even think it's a bit upgraded. This one here now I will test it with thanks to p45cal and write. I honestly adore your site and I have to tell you that I have found a lot of things on the search engine that I have modified to my needs and it has been great, even with plugins after that. Thank you and stay healthy. As for what Aussiebear wrote. Yes you are right, but in the example this 1500+100,200,300,400,500,600,700, imagine how many times I had to click, set different colors until I got to the final, and then in all the other sheets, do it again and again and again

[k0st4din]

Hi p45cal,
i tried the macro and everything is perfect.
What you did to take the color below the value just amazed me.
It's awesome, I'm speechless.
Thank you from the bottom of my heart for this help.

Only one thing left, how to make this macro action happen in Array (Peaches, London, Paris, New York, Something Else, etc.)
Again, thank you in advance and I remain available!

[Aussiebear]

Maybe this might assist

Sub blah()
    totRow = 10
    Dim sht as Worksheet
    Dim shtAry as Variant
    Set shtAry = Array("Peaches", "London", "Paris", "NewYork")
    For each sht in shtAry
        Base = Range("A" & totRow).Value
        Set HighlightCells = Intersect(Rows(totRow), Range("B:B,E:E,H:H,K:K,N:N,Q:Q,T:T,W:W,Z:Z,AC:AC,AF:AF,AI:AI"))
        Set adds = Intersect(Rows(totRow), Range("AJ:AQ"))
        For Each cll In HighlightCells.Cells
            For i = adds.Count To 1 Step -1
                Set v = adds.Cells(i)
                If cll.Value >= Base + v.Value Then
                   v.Offset(1).Copy
                   cll.PasteSpecial Paste:=xlPasteFormat
                   Exit For
                End If
            Next i
        Next cll
    Next Sht
    Application.CutCopyMode = False
End Sub

[p45cal]

Maybe this might assist

Needs one more line (although a few more changes would avoid activating anything at all):
Sheets(sht).activate after the For each sht in shtAry line.

However, I said "Lots of hard coding, lots of assumptions."
Hardcoding:
The row to work on; is it always going to be row 10? Will that row always have the 100,200,300,400 cells in it? will there always be 8 such cells? Will they always be in columns AJ to AQ? Will the values always be 100,200 300 etc.? will the formats always be in the cells immediately below them? Will the formats always be the same formats?
Will the cells to be highlighted always be in columns B,E,H,K,N,Q,T,W,Z,AC,AF,AI ?
Sheets to work on: "more than 29". That'll make for a long hard-coded list in the code! Will it always be the same sheets? Will they all exist every time? Might the user change a sheet's name? Would it be easier to define which sheets are acted upon by their position in the workbook (you could act on all sheets between 2 other sheets)?

[k0st4din]

Hello P45cal, I'll clarify right away. I have 32 sheets. Absolutely all are the same, with the same rows and columns, but each sheet has its own name of a given city. That's why I asked if you could help me to perform the same action in all of them, and not open each one separately and press a button to do the same thing for each sheet. As for the 10th row, I will change it according to my needs, it can be anyone. As for 100,200,300, etc., I will also adjust it according to my needs in the macro itself from where, how far to get info and color, even if up to 2000, I will just increase the range in the macro. But Yes, in all sheets, we are talking about an absolute copy of the same table and rows and columns. It is because of this that there is no need for very complex code. The names of the sheets will not change because only I fill them in and they are under my control. Even if there is a change, an addition, I will do it, so there is no danger of anything going wrong.As I already wrote about one sheet, it works great. My only request was how to write the names of all the sheets I want, so that with one click the same thing can be done in all of them. In your comment you say that one more line should be added besides the one for which he wrote the Aussiebear. I.e. is to add your line in the macro, is that how I understand? Thank you very much in advance!

[p45cal]

I didn't test the code before saying what I said so here is a tested version of Aussiebear's + tweak:

Sub blah()
totRow = 10
Dim sht
Dim shtAry
shtAry = Array("Peaches", "London", "Paris", "New York", "Something Else")
For Each sht In shtAry
  Sheets(sht).Activate
  Base = Range("A" & totRow).Value
  Set HighlightCells = Intersect(Rows(totRow), Range("B:B,E:E,H:H,K:K,N:N,Q:Q,T:T,W:W,Z:Z,AC:AC,AF:AF,AI:AI"))
  Set adds = Intersect(Rows(totRow), Range("AJ:AQ"))
  For Each cll In HighlightCells.Cells
    For i = adds.Count To 1 Step -1
      Set v = adds.Cells(i)
      If cll.Value >= Base + v.Value Then
        v.Offset(1).Copy
        cll.PasteSpecial Paste:=xlPasteFormats
        Exit For
      End If
    Next i
  Next cll
Next sht
Application.CutCopyMode = False
End Sub

and a version which doesn't need anything to be activated/selected:

Sub blah()
totRow = 10
Set shtAry = Sheets(Array("Peaches", "London", "Paris", "New York", "Something Else"))
For Each sht In shtAry
  With sht
    Base = .Range("A" & totRow).Value
    Set HighlightCells = Intersect(.Rows(totRow), .Range("B:B,E:E,H:H,K:K,N:N,Q:Q,T:T,W:W,Z:Z,AC:AC,AF:AF,AI:AI"))
    Set adds = Intersect(.Rows(totRow), .Range("AJ:AQ"))
    For Each cll In HighlightCells.Cells
      For i = adds.Count To 1 Step -1
        Set v = adds.Cells(i)
        If cll.Value >= Base + v.Value Then
          v.Offset(1).Copy
          cll.PasteSpecial Paste:=xlPasteFormats
          Exit For
        End If
      Next i
    Next cll
  End With
Next sht
Application.CutCopyMode = False
End Sub

[k0st4din]

Hello, everyone,
p45cal, Aussiebear, georgiboy, you guys are amazing.
There are moments when, out of happiness, one does not know what to say. In this case, it is exactly so.
Once again, I am convinced that there are sites and people on them who, with their knowledge, can help and make someone else happy.
Thank you from the bottom of my heart.
If I had to give a reputation from 1-10, I would give a Million.

P.S. - p45cal - if I can ask one last thing.
When the macro does the coloring, those selected cells change a bit for me, almost below the default value.
I mean where there is a value, whatever it is, for example 1782, after coloring (there is formatting in the cells, because they calculate data), then it shows me 1782.25874 - this is just an example.
How do I get this integer back?
I made this macro, but if there is some trick to get the formatting into yours, that would be great.

Sub FORMAT0()

       Application.ScreenUpdating = False
    Sheets(Array("BLAGOEVGRAD TOTAL", "BURGAS TOTAL", "VARNA TOTAL", _
        "VELIKO TYRNOVO TOTAL", "VIDIN TOTAL", "VRACA TOTAL", "GABROVO TOTAL", _
        "DOBRICH TOTAL", "KYRDJALI TOTAL", "KUSTENDIL TOTAL", "PAZARDJIK TOTAL", _
        "PERNIK TOTAL", "PLEVEN TOTAL", "PLOVDIV TOTAL", "RUSE TOTAL", "SILISTRA TOTAL", _
        "SMOLQN TOTAL", "SOFIA TOTAL", "SOFIA OBLAST TOTAL", "STARA ZAGORA TOTAL", _
        "HASKOVO TOTAL", "SHUMEN TOTAL", "QMBOL TOTAL")).Select
    Sheets("BLAGOEVGRAD TOTAL").Activate
    
    Range("BO78,BR78,BU78,BX78,CA78,CD78,CG78,CJ78,CM78,CP78,CS78,CV78").Select
    Range("BX78").Activate
     'or Rows("78:78").Select
    Selection.NumberFormat = "0"
   
    Sheets("BLAGOEVGRAD TOTAL").Select
    Application.ScreenUpdating = True
End Sub

[Aussiebear]

Hey if you are giving points, I'll have -1 and give the rest to the others.

[p45cal]

There are 2 ways to go about this. The way it currently does this is to copy all the formats from the cells in columns AJ:AQ:

v.Offset(1).Copy
cll.PasteSpecial Paste:=xlPasteFormats

So the first way is to ensure that all the formatting of those cells in columns AJ:AQ are as you want the target cells to be formatted (including number of decimal places).

The second way is not to copy all the formatting but only to copy over certain aspects of the formatting: Here you can replace the 2 lines above with the likes of:

cll.Interior.Color = v.Offset(1).Interior.Color 'copies the background colour of the cell
cll.Font.Bold = v.Offset(1).Font.Bold 'copies the bold (or not) formatting.

This will not affect the number formatting of the target cells; if you chose that to be zero decimal places, that'll be how it stays.

[snb]

Sub M_snb()
  sn = Sheet1.Cells(10, 1).Resize(, 35)
  
  ReDim sp(7)
  For j = 0 To 7
    sp(j) = Sheet1.Cells(11, 36 + j).Interior.Color
  Next
  
  For j = 2 To UBound(sn, 2) Step 3
    If sn(1, j) > sn(1, 1) Then Sheet1.Cells(10, j).Interior.Color = sp((sn(1, j) - sn(1, 1)) \ 100 - 1)
  Next
End Sub

for all sheets:

Sub M_snb()
  ReDim sp(7)
  For j = 0 To 7
    sp(j) = Sheet1.Cells(11, 36 + j).Interior.Color
  Next
  
  For Each it In Sheets
    sn = it.Cells(10, 1).Resize(, 35)
  
    For j = 2 To UBound(sn, 2) Step 3
       If sn(1, j) > sn(1, 1) Then it.Cells(10, j).Interior.Color = sp((sn(1, j) - sn(1, 1)) \ 100 - 1)
    Next
  Next
End Sub

[k0st4din]

Many thanks P45cal.
I am thinking of replacing these 2 lines. Over time, I may forget that I need to format a cell in the range and still wonder why the value is changing.
You're awesome, I'm just at a loss for words.....
P.S - However, when I delete the first 2 lines and replace them with the second suggestion, it gives me an error and refuses to run the macro.
Apparently I'm doing something wrong or I didn't understand it...

v.Offset(1).Copy 'deleted this
cll.PasteSpecial Paste:=xlPasteFormats 'deleted this

cll.Interior.Color = v.Offset(1).Interior.Color 'I put this one
cll.Font.Bold = v.Offset(1).Font.Bold 'and this one

[p45cal]

In full:

Sub blah()
totRow = 10
Set shtAry = Sheets(Array("Peaches", "London", "Paris", "New York", "Something Else"))
For Each sht In shtAry
  With sht
    Base = .Range("A" & totRow).Value
    Set HighlightCells = Intersect(.Rows(totRow), .Range("B:B,E:E,H:H,K:K,N:N,Q:Q,T:T,W:W,Z:Z,AC:AC,AF:AF,AI:AI"))
    Set adds = Intersect(.Rows(totRow), .Range("AJ:AQ"))
    For Each cll In HighlightCells.Cells
      For i = adds.Count To 1 Step -1
        Set v = adds.Cells(i)
        If cll.Value >= Base + v.Value Then
          cll.Interior.Color = v.Offset(1).Interior.Color 'copies the background colour of the cell
          cll.Font.Bold = v.Offset(1).Font.Bold 'copies the bold (or not) formatting.
          Exit For
        End If
      Next i
    Next cll
  End With
Next sht
Application.CutCopyMode = False
End Sub

[k0st4din]

Thank you very much!
Everything is perfect and will save me a lot of formatting on everything that has been done so far.
I repeat myself, but thank you very much!
Stay alive and healthy and don't stop helping us who don't know!