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
RWayneHAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
If you wanted to colour the active cell based on the comparison to MyValue you could try something like this.
        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

RWayneHAuthor Commented:
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.
NorieAnalyst Assistant Commented:
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
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Rob HensonFinance AnalystCommented:
ActiveCell = 100
MyValue = 90

ActiveCell is 11% higher than MyValue

Difference = 10, as percentage of original value is 10/90 = 11%
RWayneHAuthor Commented:
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?
Rob HensonFinance AnalystCommented:
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
Rob HensonFinance AnalystCommented:
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

Rob HensonFinance AnalystCommented:
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

Rob HensonFinance AnalystCommented:
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.
NorieAnalyst Assistant Commented:
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.
RWayneHAuthor Commented:
I attached the sample file.
LynxBenchmarkTracking.xlsm
Rob HensonFinance AnalystCommented:
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

RWayneHAuthor Commented:
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.
Rob HensonFinance AnalystCommented:
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
Rob HensonFinance AnalystCommented:
Which cells are you referring to as "top four rows"?
RWayneHAuthor Commented:
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?
RWayneHAuthor Commented:
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.
Rob HensonFinance AnalystCommented:
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.
Rob HensonFinance AnalystCommented:
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?
RWayneHAuthor Commented:
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.
Rob HensonFinance AnalystCommented:
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
RWayneHAuthor Commented:
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).
Rob HensonFinance AnalystCommented:
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
Rob HensonFinance AnalystCommented:
The formula was purely to test the evaluation criteria. The evaluations are working, there is something else in the file that is not.
Rob HensonFinance AnalystCommented:
Right, I have got it to work in your file; you need to define the value which you are comparing with:

Sub Testing123()
ChromeHaworthlogin = Range("ChromeHaworthLogin")

Select Case ActiveCell.Value
    Case Is > 1.15 * ChromeHaworthlogin
        ActiveCell.Interior.Color = vbRed

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

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

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

End Select
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
RWayneHAuthor Commented:
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?
Rob HensonFinance AnalystCommented:
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
RWayneHAuthor Commented:
Thanks for the help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.