• Status: Solved
• Priority: Medium
• Security: Public
• Views: 94

# Color Cells in VBA using comparing values in other cells.

Hi,

in the example attached, I need to color cells in Row 1 based off a comparison of values between values in row 4 and 5. Basically if total is within 10% of capacity, I want the cell in row 1 to be yellow; if Total is less than 90% of capacity, I want the cell in row 1 to be green and lastly, if Total is greater than 110% of capacity, I want the cell in row 1 to be red.

swjtx99
Color-Example.xlsx
0
swjtx99
• 8
• 8
• 2
• +1
2 Solutions

Commented:
Use formulas in Conditional Formatting.

For Condition 1 (yellow) use  =ABS(C\$5-C\$4)/C\$5<=0.1
For Condition 2 (red) use  =C\$4/C\$5>1.1
For Condition 3 (green) use  =C\$4/C\$5<0.9

See the attached workbook example. Note that there was an error in the original colouring in cell M1.
Color-Example.xlsx
0

Remote Training and ProgrammingCommented:
I see that Wayne gave you an answer using conditional formatting -- here is one using VBA:
``````Sub ColorCellsDifference()
'160920 s4p
Dim nRow1 As Long _
, nRow2 As Long _
, nCol1 As Long _
, nCol2 As Long _
, nCol As Long _
, nColor As Long _
, nRowToColor As Long _
, dblPercentDiff As Double

nRowToColor = 1

nCol1 = 3 'C -- start column
nCol2 = 20 'T -- end column

nRow1 = 4 '1st row
nRow2 = 5 '2nd row

With ActiveSheet
'reset colors
.Range(.Cells(nRowToColor, nCol1), .Cells(nRowToColor, nCol2)).ClearFormats
For nCol = nCol1 To nCol2
nColor = RGB(255, 255, 255) 'white
' Abs=Absolute Value
dblPercentDiff = Abs(.Cells(nRow2, nCol) - .Cells(nRow1, nCol)) _
/ (.Cells(nRow1, nCol))
Select Case True
Case dblPercentDiff <= 0.1  '+/- 10%
nColor = RGB(255, 255, 0) 'yellow
Case .Cells(nRow1, nCol) / .Cells(nRow2, nCol) > 1.1 '110%
nColor = RGB(255, 0, 0) 'red
Case .Cells(nRow1, nCol) / .Cells(nRow2, nCol) < 0.9 '90%
nColor = RGB(146, 208, 80) 'green
End Select

.Cells(nRowToColor, nCol).Interior.Color = nColor
Next nCol
End With
End Sub
``````
0

Author Commented:
Hi Crystal, This looks like it will work perfectly! The only snag is that a couple of the "Places have a Total of 0 (and a capacity of 0 too) which causes a debug divide by zero error once it hits that column. I should have included a zero in my example. Can you make it skip to the next column on error?

Thanks,

swjtx99
0

Author Commented:
Hi Crystal,

Works great. I added a resume next. No issues.
0

Remote Training and ProgrammingCommented:
sure -- here you go
``````Sub ColorCellsDifference()
'160920 s4p
Dim nRow1 As Long _
, nRow2 As Long _
, nCol1 As Long _
, nCol2 As Long _
, nCol As Long _
, nColor As Long _
, nRowToColor As Long _
, dblToleranceDiff As Double _
, dblPercentDiff As Double

nRowToColor = 1

nCol1 = 3 'C=3 -- start column
nCol2 = 20 'T =20 -- end column

nRow1 = 4 '1st row
nRow2 = 5 '2nd row

With ActiveSheet
'reset colors
.Range(.Cells(nRowToColor, nCol1), .Cells(nRowToColor, nCol2)).ClearFormats
For nCol = nCol1 To nCol2
nColor = RGB(255, 255, 255) 'white
'assuming +/- for all comparisons
' Abs=Absolute Value
If .Cells(nRow1, nCol) = "" Or .Cells(nRow2, nCol) = "" _
Or .Cells(nRow1, nCol) = 0 Or .Cells(nRow2, nCol) = 0 Then
dblToleranceDiff = 0
Else
dblToleranceDiff = (.Cells(nRow2, nCol) - .Cells(nRow1, nCol)) _
/ (.Cells(nRow1, nCol))
End If
If .Cells(nRow1, nCol) = "" Or .Cells(nRow2, nCol) = "" _
Or .Cells(nRow1, nCol) = 0 Or .Cells(nRow2, nCol) = 0 Then
dblPercentDiff = 0
Else
dblPercentDiff = (.Cells(nRow2, nCol) / .Cells(nRow1, nCol))
End If

Select Case True
Case dblToleranceDiff <= 0.1  '+/- 10%
nColor = RGB(255, 255, 0) 'yellow
Case dblPercentDiff > 1.1 '110%
nColor = RGB(255, 0, 0) 'red
Case dblPercentDiff < 0.9 '90%
nColor = RGB(146, 208, 80) 'green
End Select

.Cells(nRowToColor, nCol).Interior.Color = nColor
Next nCol
End With
End Sub
``````
If you like this, please also consider that Wayne answered the question as well. While you asked for VBA, Conditional Formatting is good too -- and does not require macros to be enabled.
0

Remote Training and ProgrammingCommented:
you're welcome ~ happy to help

you awarded points before my last post -- thank you but ...
Something to keep in mind for the future...
...  it is good to consider others who made an effort to help -- especially when they took time to make a workbook and post if for you.  I realize you are probably busy, but all who make a genuine effort to help you should be acknowledged when you award points -- you can always split them.
0

Author Commented:
Hi Crystal,

Oops, the "On Error Resume Nex"t I added still colored the cell in Row 1 red. I think what I need is for it to color it white in case it was a color and then values change later. If I just skip it, it will leave It the color it was before I run the code.

swjtx99
0

Remote Training and ProgrammingCommented:
you're welcome and thank you

did you try the second version?

In order to properly handle errors, an error handler should be added:

Here are some  short videos on error handling posted on EE (you should watch them!):

1. basic error handling code for VBA (3:48)
http://www.experts-exchange.com/videos/1478/Excel-Error-Handling-Part-1-Basic-Concepts.html

2. Run and Fix Code Loop through rows of an Excel spreadsheet using VBA (6:00)
http://www.experts-exchange.com/videos/1498/Excel-Error-Handling-Part-2-VBA-to-Copy-Values-Down-to-Blank-Cells-in-an-Excel-Column.html

3. Excel Error Handling Part 3 - Run and Fix Bugs (7:51)
http://www.experts-exchange.com/videos/1518/Excel-Error-Handling-Part-3-Run-and-Fix-Bugs.html
0

Author Commented:
Hi Crystal,

No Error messages but I'm only getting either yellow or red (no green) and the boxes that should be white, are yellow.

My apologies for not acknowledging Wayne's post. Certainly appreciate any responders.
0

Author Commented:
Hi  Crystal,

After looking further, It's actually coloring come cells red that should be green. For example if I put "100" in row 5 and "50" in row 4, row 1 should be green but it colored it red.

There are other that should be red but the code colored them yellow. I put 135 in Row 5 and 180 in row 4 which should make row 1 red but it's yellow.

Thanks,
0

Remote Training and ProgrammingCommented:
your equations were not specified and what was written was not clear  -- I modified the code to get what your example showed.  Perhaps you could specify the logic a bit better and include some examples and how you would calculate it? thanks
0

Excel & VBA ExpertCommented:
Why do you need a VBA code to do that while this can be easily achieved with the help of conditional formatting and it's one time setup.

Select C1:T1 and make new rules for conditional formatting using the formulas given below and set the format as per your choice....

For Yellow:
=AND(C4>=C5*0.9,C4<=C5*1.1)

For Red:
=C4>C5*1.1

For Green:
=C4<C5*0.9

For details, refer to the attached.
Color-Example.xlsx
0

Remote Training and ProgrammingCommented:
namaste Subodh -- good observation.  My equations are not as you wrote  -- but it was hard to tell what they should be since they were not well specified.  I modified the code to match your equations but running it does not get the same colors as the example.  It seems that there was a gap in what was specified.

swjtx99 (what is your name?) -- if you want to take the points away (unclose the question and open it again? not sure how to do that, you may need to get help from administrator) and listen to what others have to say to consider other options, that is fine with me ... or maybe ask another question and specify what you need a bit better?
0

Commented:
If it's VBA you really, really want, I would do it this way...

``````Sub ColorCells()

Dim cell As Range
For Each cell In Range("C1:T1")
Select Case Cells(4, cell.Column) / Cells(5, cell.Column)
Case Is > 1.1
cell.Interior.Color = vbRed
Case Is < 0.9
cell.Interior.Color = vbGreen
Case Else
cell.Interior.Color = vbYellow
End Select
Next

End Sub
``````
0

Excel & VBA ExpertCommented:
Namaste Crystal!
The condition formatting looked very obvious solution keeping the OP's requirement in mind, that's why I suggested that solution.
Well the conditional formatting responds to either True or False returned by the conditional formatting formulas. But rules must be the same whether in VBA code or conditional formatting.
Also as you said that I used different equations for the formulas, let me tell you that I am not very good in mathematical calculations but this was an easy enough calculation scenario even for me. Lol

Though I suggested the Conditional formatting solution, we will have to wait for OP to respond and then only we would know that this is something OP can work with.
0

Author Commented:
Hi,

So sorry for the confusion. I am attaching an updated example.
Basically:
If the "Total" is less than 90% of the "Capacity" the C1 should be green.
If the "Total" is Greater than 110% of the "Capacity" C1 should be red.
If the "Total" is between 90% and 110% of "Capacity", C1 should be yellow.
If either "Capacity" or "Total" is missing (blank) C1 should be white.

On the original example file in the text box, I put a statement "needs to be a VBA solution". This is because this file is created several times a day (with VBA) so I don't want to redo conditional formatting each time a new version is created. With VBA, I can put the code at the end of the existing code to format this sheet each time it is created.

swjtx99 (My name is Tregesar)
Color-Example.xlsx
0

Remote Training and ProgrammingCommented:
``````Sub ColorCellsDifference()
'160921 s4p
Dim nRow1 As Long _
, nRow2 As Long _
, nCol1 As Long _
, nCol2 As Long _
, nCol As Long _
, nColor As Long _
, nRowToColor As Long _
, dbRatio As Double

nRowToColor = 1

nCol1 = 3 'C=3 -- start column
nCol2 = 20 'T =20 -- end column

nRow1 = 4 '1st row
nRow2 = 5 '2nd row

With ActiveSheet
'reset colors
.Range(.Cells(nRowToColor, nCol1), .Cells(nRowToColor, nCol2)).ClearFormats
For nCol = nCol1 To nCol2
nColor = RGB(255, 255, 255) 'white
If .Cells(nRow1, nCol) = "" Or .Cells(nRow2, nCol) = "" _
Or .Cells(nRow1, nCol) = 0 Or .Cells(nRow2, nCol) = 0 Then
'do nothing
Else
dbRatio = (.Cells(nRow1, nCol) / .Cells(nRow2, nCol))
Select Case True
Case dbRatio < 0.9  '90%
nColor = RGB(146, 208, 80) 'green
Case dbRatio > 1.1 '110%
nColor = RGB(255, 0, 0) 'red
Case dbRatio >= 0.9 And dbRatio <= 1.1 '+/- 10%
nColor = RGB(255, 255, 0) 'yellow
End Select
.Cells(nRowToColor, nCol).Interior.Color = nColor
End If

Next nCol
End With
End Sub
``````

this is similar to what Wayne gave you except his colors everything yellow that is not green or red.  In this code, variables are being defined so it is easy to change which rows and columns are being looked at, and which row to color (for testing I set this to another row so I could compare the colors with row 1). This code also clears the formatting of the range first and takes into account if a cell has a value or not. When you award points again, please consider everyone who helped.
0

Author Commented:
Hi Crystal,

This worked for all cases. I've requested the question be unclosed so will select this as best answer but split with Wayne as per your recommendation.

Thanks very much again,

swjtx99
0

Author Commented:
Thanks to you both for your help!
0

Remote Training and ProgrammingCommented:
you're welcome ~ happy to help
0

## Featured Post

• 8
• 8
• 2
• +1
Tackle projects and never again get stuck behind a technical roadblock.