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

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.

Thanks in advance,

swjtx99
Color-Example.xlsx
0
swjtx99
Asked:
swjtx99
  • 8
  • 8
  • 2
  • +1
2 Solutions
 
Wayne Taylor (webtubbs)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
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
         Case Else 'no additional color
         End Select
         
         .Cells(nRowToColor, nCol).Interior.Color = nColor
      Next nCol
   End With
End Sub 

Open in new window

0
 
swjtx99Author 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
swjtx99Author Commented:
Hi Crystal,

Works great. I added a resume next. No issues.
0
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
         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
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
 
swjtx99Author 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.

Appreciate your help,

swjtx99
0
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
 
swjtx99Author 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
 
swjtx99Author 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
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
 
Subodh Tiwari (Neeraj)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.

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
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
 
Wayne Taylor (webtubbs)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

Open in new window

0
 
Subodh Tiwari (Neeraj)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
 
swjtx99Author 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.

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

swjtx99 (My name is Tregesar)
Color-Example.xlsx
0
 
crystal (strive4peace) - Microsoft MVP, AccessRemote 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
            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
 
swjtx99Author 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
 
swjtx99Author Commented:
Thanks to you both for your help!
0
 
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome ~ happy to help
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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