Run Macro on Change of formula result value in cell

[High Plains Grifter]

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 :¬)

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

 

[RoryA]

You either need the Calculate event, or you need your Change event to monitor the input cells, not the formula cell.

 

[VoG]

Try

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

 

[High Plains Grifter]

Brilliant! Thanks very much :¬D