Change cell colour based on increase/decrease in previous value (same cell)

[jayden13]

Hello,

I am looking for support to change a cell color based on whether or not it is an increase or decrease from the previous value.

For example if A1 is "1" and I manually changed it to "2", A1 fill color would change to green (increase) and if A1 was manually changed to 0, the color would change to red (decrease).

Thank you!

 

[Dossfm0q]

greetings
This function well, Copy and paste onto worksheet Module, please feed back

Private Sub Worksheet_Change(ByVal Target As Range)

Dim OldValue As String, NewValue As String
    Application.ScreenUpdating = False
        Application.EnableEvents = False
    On Error Resume Next
            Application.Undo
            OldValue = Target.Value
            Application.Undo
            NewValue = Target.Value
            
            If NewValue > OldValue And OldValue <> "" Then
                With Target
                    With .Interior
                        .Pattern = xlSolid
                        .Color = RGB(170, 207, 140)
                    End With
                    With .Font
                        .Color = RGB(55, 85, 35)
                    End With
                End With
            ElseIf NewValue < OldValue And OldValue <> "" Then
                With Target
                    With .Interior
                        .Pattern = xlSolid
                        .Color = RGB(255, 140, 140)
                    End With
                    With .Font
                        .Color = RGB(155, 0, 0)
                    End With
                End With
            End If
         On Error GoTo 0
        Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

 

[AntMac]

greetings
This function well, Copy and paste onto worksheet Module, please feed back

Private Sub Worksheet_Change(ByVal Target As Range)

Dim OldValue As String, NewValue As String
    Application.ScreenUpdating = False
        Application.EnableEvents = False
    On Error Resume Next
            Application.Undo
            OldValue = Target.Value
            Application.Undo
            NewValue = Target.Value
           
            If NewValue > OldValue And OldValue <> "" Then
                With Target
                    With .Interior
                        .Pattern = xlSolid
                        .Color = RGB(170, 207, 140)
                    End With
                    With .Font
                        .Color = RGB(55, 85, 35)
                    End With
                End With
            ElseIf NewValue < OldValue And OldValue <> "" Then
                With Target
                    With .Interior
                        .Pattern = xlSolid
                        .Color = RGB(255, 140, 140)
                    End With
                    With .Font
                        .Color = RGB(155, 0, 0)
                    End With
                End With
            End If
         On Error GoTo 0
        Application.EnableEvents = True
    Application.ScreenUpdating = True
   
End Sub

I like what you did there, but just thinking by reading what's here. Should the second undo be a redo instead?

 

[Dossfm0q]

Greetings
it ok no redo