Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
Solved

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

Posted on 2016-09-20
Medium Priority
78 Views
Last Modified: 2016-09-22
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.

Thanks in advance,

swjtx99
Color-Example.xlsx
0
Question by:swjtx99
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• Learn & ask questions
• 8
• 8
• 2
• +1
20 Comments

LVL 48

Expert Comment

ID: 41807857
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

LVL 22

Expert Comment

ID: 41807882
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
Case Else 'no additional color
End Select

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

Author Comment

ID: 41807904
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 Comment

ID: 41807909
Hi Crystal,

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

LVL 22

Expert Comment

ID: 41807911
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
Case Else 'no additional color
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

LVL 22

Expert Comment

ID: 41807919
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 Comment

ID: 41807922
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.

Appreciate your help,

swjtx99
0

LVL 22

Expert Comment

ID: 41807927
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 Comment

ID: 41807953
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 Comment

ID: 41807961
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

LVL 22

Expert Comment

ID: 41807976
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

LVL 33

Expert Comment

ID: 41807987
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.

Please follow these steps to apply conditional formatting.....

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

LVL 22

Expert Comment

ID: 41807999
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

LVL 48

Assisted Solution

Wayne Taylor (webtubbs) earned 1000 total points
ID: 41808005
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

LVL 33

Expert Comment

ID: 41808017
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 Comment

ID: 41808948
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.

Crystal, I'll contact an admin about unclosing per your suggestion

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

LVL 22

Accepted Solution

crystal (strive4peace) - Microsoft MVP, Access earned 1000 total points
ID: 41809193
``````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
Case Else 'no additional color
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 Comment

ID: 41809299
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 Closing Comment

ID: 41810592
Thanks to you both for your help!
0

LVL 22

Expert Comment

ID: 41811195
you're welcome ~ happy to help
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
Cancel future meetings from user mailboxes in Office 365 using Remove-CalendarEvents
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custoâ€¦
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filledâ€¦
###### Suggested Courses
Course of the Month9 days, 5 hours left to enroll

#### 604 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.