Link to home
Start Free TrialLog in
Avatar of RWayneH
RWayneHFlag for United States of America

asked on

VBA that compares two values and colors the cell

I move the ActiveCell around using Offset commands.  How would I evaluate the ActiveCell and a variable (MyValue), so it can highlight the cell a color?

Compare ActiveCell and MyValue:

Need to figure out the percentage difference between the ActiveCell and MyValue, if it is higher or lower?  So if ActiveCell is 100 and MyValue is 90, ActiveCell is 10% higher  (or yellow based on color rules below)

To add the color to the cell based on the percent?

If ActiveCell is >15% of MyValue = Red
If ActiveCell is between 10% of MyValue but <15% of MyValue = Yellow
If ActiveCell is under 10% but not lower than -10% = Green
If ActiveCell is -10% or lower  = Light blue

Then I move to a different ActiveCell and check that one.  Need some help writing this vba to color my cells.
Please advise and thanks
SOLUTION
Avatar of Norie
Norie

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of RWayneH

ASKER

I am not sure the calculation is correct..  everything is coming back red.  I tried activecell of 100 and MyValue of 90,  that is 10% and it should result in yellow, not red.
Avatar of Norie
Norie

Can you post what you actually tried?

PS How do you actually want to compare the values?

If ActiveCell's values is 100 and MyValue is 90 then MyValue is 10% less than ActiveCell
ActiveCell = 100
MyValue = 90

ActiveCell is 11% higher than MyValue

Difference = 10, as percentage of original value is 10/90 = 11%
Avatar of RWayneH

ASKER

Robs example is what I am looking for,  ActiveCell is being compared to MyValue, so in his example 11% should be yellow and it turns out as Red?  I think Norie's suggested code had it backwards a multiplying when I think it should determine the difference then divide... but when I try to change the code...  well it does not work.  How would I apply this to the suggested code?
Norie has the Multiplication correct. MyValue * 1.15 gives 103.5

For the value of 90 in MyValue the ranges are:

Red         >1.15              >103.5
Yellow    1.1 to 1.15     99 to 103.5
Green     0.9 to 1.1       81 to 99
Blue        <0.9                <81

100 does therefore fit in the Yellow bracket
To prevent the overlap of the ranges, does it need to be:

Select Case ActiveCell.Value
  Case Is > 1.15 * MyValue
    ActiveCell.Interior.Color = vbRed
  Case > 1.1 * MyValue To 1.15 * MyValue
    ActiveCell.Interior.Color = vbYellow
  Case > 0.9 * MyValue To 1.1 * MyValue
    ActiveCell.Interior.Color = vbGreen
  Case Is <= 0.9 * MyValue
    ActiveCell.Interior.Color = vbBlue
End Select

Open in new window

I just copied Norie's code into Excel and it did not like the lines where it was a range of values, eg "1.1 * My Value to 1.15 * MyValue"

It was expecting an End of Statement at the To.

So amended code:
Select Case ActiveCell.Value
    Case Is > 1.15 * MyValue
        ActiveCell.Interior.Color = vbRed
        Exit Sub

    Case Is > 1.1 * MyValue
        ActiveCell.Interior.Color = vbYellow
        Exit Sub

    Case Is > 0.9 * MyValue
        ActiveCell.Interior.Color = vbGreen
        Exit Sub

    Case Is <= 0.9 * MyValue
        ActiveCell.Interior.Color = vbBlue
        Exit Sub
End Select

Open in new window

Downside to that is if you then do other things after the cell formatting these won't occur as each section of the Select Case will exit the sub.

Try this instead:

Sub CheckValue()
MyValue = Range("MyValue")

GoSub FillCell
....Other Lines.....
Exit Sub

FillCell:
Select Case ActiveCell.Value
    Case Is > 1.15 * MyValue
        ActiveCell.Interior.Color = vbRed
        Return

    Case Is > 1.1 * MyValue
        ActiveCell.Interior.Color = vbYellow
        Return

    Case Is > 0.9 * MyValue
        ActiveCell.Interior.Color = vbGreen
        Return

    Case Is <= 0.9 * MyValue
        ActiveCell.Interior.Color = vbBlue
        Return
End Select
End Sub

Open in new window


If your ActiveCell value falls exactly on a threshold boundary, what colour do you want it?

For example, using the figures earlier, 103.5 would be yellow as it is right at the top of that range; with the change to red occurring for anything greater than 103.5.
Rob

You shouldn't need Exit Sub/Return in a Select Case.

As soon as the criteria of one is met and the associated code executed program control should move on to whatever is after End Select.
Avatar of RWayneH

ASKER

I attached the sample file.
LynxBenchmarkTracking.xlsm
Yep, just tried that and it worked.
I thought it would check all Case statements and action them.

So code would be:
Select Case ActiveCell.Value
    Case Is > 1.15 * MyValue
        ActiveCell.Interior.Color = vbRed

    Case Is > 1.1 * MyValue
        ActiveCell.Interior.Color = vbYellow

    Case Is > 0.9 * MyValue
        ActiveCell.Interior.Color = vbGreen

    Case Is <= 0.9 * MyValue
        ActiveCell.Interior.Color = vbBlue

End Select

Open in new window

Avatar of RWayneH

ASKER

This details on the sample file.  I am trying to compare the stored values, (averages) on the Chart sheet tab, (off to the right of the charts) with value that is in the top four rows.

Running macro: ReplaceAverages    updates the named cells in the Chart sheet tab.
Running macro: Testing123     Is the test macro to chg the colors.
Running macro: HighlightNewCells, handles coloring the 12 new values that each have Averages  ( the MyValue in the example code)

Hope this helps.
And what is the issue with the attached file???

I see you have added the code as macro Testing123. This is comparing cells to ChromeHowarthLogin which has a value of 0.410360714
Which cells are you referring to as "top four rows"?
Avatar of RWayneH

ASKER

Does it matter that the named cells in the Chart sheet tab are on a different sheet tab then the ActiveCell?  Maybe it is not pulling the value in the named cells?
Avatar of RWayneH

ASKER

I am selecting, D2, evaluating it, offset to E2 evaluating, offset and F2....  each one has its unique MyValue, that was used as an example that I was applying to each cell.  You can review the HighlightNewCells macro that does that. ( it will make more sense).

So the evaluated cells are not ranges, they individual specific cells.  So the first four rows refer to D2, E2 F2, D3, E3 F3, D4, E4 F4 and D5, E5 F5.
I can now see your issue (I think).

I believe you are referring to the values in columns D to F on Data Table and want to colour those accordingly, correct me on this if not.

I have tried running the script on these cells and they all go Red. I have copied the first four rows of this data to the same sheet as the comparison value and the same, they go red.
Using a formula to evaluate the cells, I get the following results:

Copied from Data Sheet
0.1111      0.4602      0.6934
2.3609      0.6945      1.71
0.6852      0.0929      0.2016
1.6255      0.4759      1.4426
            
Formula:
=IF(Z19<=ChromeHaworthLogin*0.9,"Blue",IF(Z19>ChromeHaworthLogin*0.9,"Green",IF(Z19>ChromeHaworthLogin*1.1,"Yellow",IF(Z19>ChromeHaworthLogin*1.15,"Red"))))

Z19 being the cell containing the first value 0.1111 and then copied down and right for the other cells.

Results:
Blue       Green      Green
Green      Green      Green
Green      Blue              Blue
Green      Green      Green

Do you agree that this is the result you'd expect?
Avatar of RWayneH

ASKER

Yes but not the columns, cells only and actually 12 cells evaluated uniquely.  Data is added to the DataTable and I only want to color the newly added cells, not changing what was already there.   So you are seeing the same thing I am...   What is causing them to go red?  Even when I chg the data for testing, they still go red.  I was trying to get a Green, Yellow, Blue... test and not working.
Sorry, formula should have been:

=IF(Z19<=ChromeHaworthLogin*0.9,"Blue",IF(Z19>ChromeHaworthLogin*1.15,"Red",IF(Z19>ChromeHaworthLogin*1.1,"Yellow",IF(Z19>ChromeHaworthLogin*0.9,"Green"))))

Giving results:
Blue       Yellow       Red
Red       Red       Red
Red       Blue             Blue
Red       Red       Red
Avatar of RWayneH

ASKER

Not totally following the formula, approach..  I have the rules in the original question...  no copying to other cells, each cell is being compared to its own Avg (or MyValue)...  the MyValue was just an example to use for one cell, the next cell will use a different MyValue...  Please read the HighlightNewCells marco and you will see.  It used the list of Averages in the Chart sheet... (right of charts).
If I copy those values and the ChromeHowarth value to a separate workbook, it works as expected.

See attached.

Select the range L15 to N18 (as a group or individually) and click the blue button.
RGYB-test.xlsm
The formula was purely to test the evaluation criteria. The evaluations are working, there is something else in the file that is not.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of RWayneH

ASKER

YES!!! that was it.  Kind of an odd last question regarding this.  The vbBlue is not a good color to use as a cell background.  How do I get a lighter blue in there so the cell contains are more readable?
From this msdn link:

https://msdn.microsoft.com/en-us/VBA/language-reference-vba/articles/color-constants

Pale blue   ActiveCell.Interior.Color = vbCyan
Pink   ActiveCell.Interior.Color = vbMagenta
Avatar of RWayneH

ASKER

Thanks for the help.