Change Cell Interior Color Based on Comparison Value

P

pawville

New Member
Joined
Apr 5, 2006
Messages
18
Hello,
I am trying to create a macro that will check each cell value in a specified range of cells to see if the cell value is less than or equal to the value in a static row and same column as the cell value that is being checked. If the cell value being checked is null nothing will change. If the cell value is less than or equal to the compared value, the cell interior color will change to green, else the cell interior color will change to red.

I will have to repeat this on multiple ranges within my worksheet.

My code so far changes the interior color of all cells in the range.

I am new to VBA so forgive my ignorance.

Here is my current code:

Sub Change_Cell_Color()
Dim MyCell As Variant
For Each MyCell In Range("B7:G24")
If Not IsNull(MyCell <= Cells(, 6).Value) Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
Next MyCell
End Sub

Any help is greatly appreciated. Thank you for your help and time.
 
Sort by date Sort by votes
pawville said:
Hello,
I am trying to create a macro that will check each cell value in a specified range of cells to see if the cell value is less than or equal to the value in a static row and same column as the cell value that is being checked. If the cell value being checked is null nothing will change. If the cell value is less than or equal to the compared value, the cell interior color will change to green, else the cell interior color will change to red.

I will have to repeat this on multiple ranges within my worksheet.

My code so far changes the interior color of all cells in the range.

I am new to VBA so forgive my ignorance.

Here is my current code:

Sub Change_Cell_Color()
Dim MyCell As Variant
For Each MyCell In Range("B7:G24")
If Not IsNull(MyCell <= Cells(, 6).Value) Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
Next MyCell
End Sub

Any help is greatly appreciated. Thank you for your help and time.
Click to expand...
Hi Pawville,

Try out the following replacement code. I have added in the comments so you can familiarise yourself with what the macro is doing:

Rich (BB code): 
Sub ColorCells()' Defines variables
Dim Cell As Range, cRange As Range
' Sets check range as B7:G24
Set cRange = Range("B7:G24")
' For each cell in check range
    For Each Cell In cRange
' If the cell value is not blank then...
        If Cell.Value <> "" Then
' If the cell value is less than or equal to column H value of the same row then...
            If Cell.Value <= Range("H" & Cell.Row).Value Then
' Fill cell GREEN
                Cell.Interior.ColorIndex = 4
' Else If cell value is greater than column H value of the same row then...
            ElseIf Cell.Value > Range("H" & Cell.Row).Value Then
' Fill cell RED
                Cell.Interior.ColorIndex = 3
            End If
        End If
' Check next cell in check range
    Next Cell
End Sub
 
Upvote 0
I may be wrong but I read it as...
Excel Workbook
BCDEFG
61223456
7111111
8222
9333333
10444444
11555555
1266666
13777777
14888888
15999999
16101010
171111111111
181212121212
191313131313
201414141414
211515151515
221616161616
23171717171717
24181818181818
Sheet18


With code...

Code: 
Sub Change_Cell_Color()
Dim MyCell As Variant
For Each MyCell In Range("B7:G24")
If Not MyCell = "" Then
If MyCell <= Cells(6, MyCell.Column).Value Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
End If
Next MyCell
End Sub

Hope that helps.
 
Upvote 0
Fishboy said:
Hi Pawville,

Try out the following replacement code. I have added in the comments so you can familiarise yourself with what the macro is doing:

Rich (BB code): 
Sub ColorCells()' Defines variables
Dim Cell As Range, cRange As Range
' Sets check range as B7:G24
Set cRange = Range("B7:G24")
' For each cell in check range
    For Each Cell In cRange
' If the cell value is not blank then...
        If Cell.Value <> "" Then
' If the cell value is less than or equal to column H value of the same row then...
            If Cell.Value <= Range("H" & Cell.Row).Value Then
' Fill cell GREEN
                Cell.Interior.ColorIndex = 4
' Else If cell value is greater than column H value of the same row then...
            ElseIf Cell.Value > Range("H" & Cell.Row).Value Then
' Fill cell RED
                Cell.Interior.ColorIndex = 3
            End If
        End If
' Check next cell in check range
    Next Cell
End Sub
Click to expand...

Thank you Fishboy for the prompt reply. That is basically what I need. The only change is the row will always be the same but the column will change. I tried to google the right naming schema for a fixed row but no luck. Any thoughts? Thank you again for your help and time.
 
Upvote 0
Snakehips said:
I may be wrong but I read it as...
Excel Workbook
BCDEFG
61223456
7111111
822***2
9333333
10444444
11555555
12*66666
13777777
14888888
15999999
161010***10
171111*111111
181212*121212
191313*131313
201414*141414
211515*151515
221616*161616
23171717171717
24181818181818
Sheet18


With code...

Code: 
Sub Change_Cell_Color()
Dim MyCell As Variant
For Each MyCell In Range("B7:G24")
If Not MyCell = "" Then
If MyCell <= Cells(6, MyCell.Column).Value Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
End If
Next MyCell
End Sub

Hope that helps.
Click to expand...

Thank you Tony! That is exactly the result I was looking for. Can I repeat that loop for multiple ranges without declaring them up front (just changing them in each loop) or would it be better to declare the ranges first and then run the loop for each declared range? Thank you again for your help and time.
Sincerely,
Fred
 
Upvote 0
Hi Fred,

Happy to have been of assistance.

Re multiple ranges, can you clarify ...

Are these fixed ranges?
How many?
Each has different row for the compare data?

Can you give some actual ranges if known?
 
Upvote 0
Snakehips said:
Hi Fred,

Happy to have been of assistance.

Re multiple ranges, can you clarify ...

Are these fixed ranges?
How many?
Each has different row for the compare data?

Can you give some actual ranges if known?
Click to expand...

Hi Tony,
The ranges will be fixed and there will be 20 of them if I calculated correctly. There are five fixed rows to compare with:

For example:

B7:D24, F7:N24, O7:O24, P7:P24 compared with (row 6)
B27:D53, F27:N53, O27:O53, P27:P53 compared with (row 26)

Comparisons will change in some of the ranges to be greater than or equal to instead of less than or equal to.

Ask questions if you have them.
Thank you again for your help and time.
Sincerely,
Fred
 
Upvote 0
Fred,

Observations on that.
Is e.g. F7:F27, O7:O27, P7:P27 not F7:P27 ???

Anyway, below is an example of how I might exploit the the 20 row offset of the two similar composite ranges given.
If you cannot see / exploit some constant relationship between the various ranges to enable some sort of looping then you will have to adapt / repeat the original code to apply, composite range by composite range.

Code: 
Sub Change_Cell_Color()
Dim MyCell As Variant
Dim MyRng As Range
Dim OSet As Integer
Dim TestRow As Integer


For OSet = 0 To 20 Step 20
Set MyRng = Range("B7:D24, F7:N24, O7:O24, P7:P24").Offset(OSet, 0)
For Each MyCell In MyRng
If Not MyCell = "" Then
If MyCell <= Cells(6 + OSet, MyCell.Column).Value Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
End If
Next MyCell
Next OSet
End Sub

Hope that illustrates?
 
Last edited:
Upvote 0
Snakehips said:
Fred,

Observations on that.
Is e.g. F7:F27, O7:O27, P7:P27 not F7:P27 ???

Anyway, below is an example of how I might exploit the the 20 row offset of the two similar composite ranges given.
If you cannot see / exploit some constant relationship between the various ranges to enable some sort of looping then you will have to adapt / repeat the original code to apply, composite range by composite range.

Code: 
Sub Change_Cell_Color()
Dim MyCell As Variant
Dim MyRng As Range
Dim OSet As Integer
Dim TestRow As Integer


For OSet = 0 To 20 Step 20
Set MyRng = Range("B7:D24, F7:N24, O7:O24, P7:P24").Offset(OSet, 0)
For Each MyCell In MyRng
If Not MyCell = "" Then
If MyCell <= Cells(6 + OSet, MyCell.Column).Value Then
MyCell.Interior.Color = RGB(0, 255, 0)
Else
MyCell.Interior.Color = RGB(255, 0, 0)
End If
End If
Next MyCell
Next OSet
End Sub

Hope that illustrates?
Click to expand...

Thank you again Tony.

The ranges I gave you were correct. I did not set up my worksheet to encompass an entire range so I could not use F7:P27 as use suggest. I do have to split them up.

Your guidance is helpful and I do understand that if I can identify a constant (i.e. same number of rows in ranges or even between ranges) I may be able to reduce the number of loops to include in the code.

Thank you again and have a great one.
Sincerely,
Fred
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Multiple conditional formatting
Replies
6
Views
552
StephenCrump
S
C
  • Solved
Chase cell color for every other variable
2
Replies
13
Views
990
Joe4
Joe4
D
  • Solved
Problem with Cell Colouring - VBA
Replies
6
Views
183
Dinngz
D
P
  • Question Question
Excel VB UserForm - Change CommandButton BackColor after click in my Userform - change back to standardColor after click again...
2
Replies
18
Views
395
DanteAmor
DanteAmor
V
  • Question Question
Disallowing user to change cell color
Replies
5
Views
223
Logit
Logit

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top