Solved

Color Cells in VBA using comparing values in other cells.

Posted on 2016-09-20
20
47 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
 

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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
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 28

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 28

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
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…

746 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now