Run Macro on Change of formula result value in cell

High Plains Grifter

Board Regular
Joined
Mar 9, 2010
Messages
129
Hello Excellent people!

I have made a macro which is designed to change the colour of some shapes depending on the value in a cell. It all works fine when it runs, but it only runs when I exit the formula bar of the cell. Since the taget cell has a formula in it (basic division of two numbers to give a percentage), the displayed value in the cell can change without the user entering the formula bar.

I would like the shapes to change colour when the displayed value in the cell changes, even though the cell (as it will be) is locked for editing, so no one will be actually clicking on it. The cell may even be hidden eventually.

Is this possible?

Just for reference, my code is as follows (it makes traffic lights at the moment, but it will grow :¬)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'once we have the action, we need no more events
Application.EnableEvents = False
Dim Red As Integer
Dim Green As Integer
Dim Orange As Integer
Dim Off As Integer
'Set the colours with the matching Schemecolor values
Red = 2
Orange = 52
Green = 3
Off = 74
'
If Target.Address = "$A$1" Then
    Select Case Target.Value
        Case 0 To 33.33
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Red
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
        Case 33.33 To 66.67
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Orange
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
        Case 66.67 To 1000.5
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Green
    End Select
        'take the select box off the picture cos it looks nasty
        Range("A1").Activate
        'let the fella have his fun again
        Application.EnableEvents = True
End If
'
End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
37,134
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You either need the Calculate event, or you need your Change event to monitor the input cells, not the formula cell.
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Code:
Private Sub Worksheet_Calculate()
'once we have the action, we need no more events
Application.EnableEvents = False
Dim Red As Integer
Dim Green As Integer
Dim Orange As Integer
Dim Off As Integer
'Set the colours with the matching Schemecolor values
Red = 2
Orange = 52
Green = 3
Off = 74
'
    Select Case Range("A1").Value
        Case 0 To 33.33
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Red
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
        Case 33.33 To 66.67
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Orange
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
        Case 66.67 To 1000.5
                ActiveSheet.Shapes.Range(Array("RedLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("OrangeLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Off
'
                ActiveSheet.Shapes.Range(Array("GreenLight")).Select
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = Green
    End Select
        'take the select box off the picture cos it looks nasty
        Range("A1").Activate
        'let the fella have his fun again
        Application.EnableEvents = True
'
End Sub
 

Forum statistics

Threads
1,136,641
Messages
5,676,956
Members
419,663
Latest member
Xbox_360

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top