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
Solved

Color Cells in VBA using comparing values in other cells.

Posted on 2016-09-20
20
61 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
Comment
Question by:swjtx99
  • 8
  • 8
  • 2
  • +1
20 Comments
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
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 19
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 

Open in new window

0
 

Author Comment

by:swjtx99
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
Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

 

Author Comment

by:swjtx99
ID: 41807909
Hi Crystal,

Works great. I added a resume next. No issues.
0
 
LVL 19
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

Open in new window

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 19
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

by:swjtx99
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 19
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

by:swjtx99
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

by:swjtx99
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 19
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 30

Expert Comment

by:Subodh Tiwari (Neeraj)
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 19
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 47

Assisted Solution

by:Wayne Taylor (webtubbs)
Wayne Taylor (webtubbs) earned 250 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

Open in new window

0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
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

by:swjtx99
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 19

Accepted Solution

by:
crystal (strive4peace) - Microsoft MVP, Access earned 250 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

Open in new window


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

by:swjtx99
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

by:swjtx99
ID: 41810592
Thanks to you both for your help!
0
 
LVL 19
ID: 41811195
you're welcome ~ happy to help
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
first name and last initial in excel 11 29
Add Attendee Macro need not halt for Acknowledgement 12 23
Excel VBA 30 43
Loop with matrices. Please help me! 16 42
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
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…

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

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

Join & Ask a Question