Displaying symbol on increase/decrease in cell value

dknowles2004

Board Regular
Joined
Nov 15, 2004
Messages
79
I'm not sure if this is do-able but I have a numeric value in cell D50. I'd like to make the background cell turn RED when the value decreases and GREEN when it increases.

Additionally, id like to display the word UP (for increase) and DOWN (for decrease) in cell D51.

Does anyone have any ideas on this?

Thanks.
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Right click the sheet tab and choose View Code. Paste this into the window on the right.

Code:
Private Sub Worksheet_Calculate()
    Static OldValue As Double
    With Range("D50")
        If IsEmpty(OldValue) Then OldValue = .Value
        If .Value = OldValue Then
             Exit Sub
        ElseIf .Value < OldValue Then
            .Interior.ColorIndex = 3
            .Offset(1, 0).Value = "DOWN"
        Else
            .Interior.ColorIndex = 10
            .Offset(1, 0).Value = "UP"
        End If
        OldValue = .Value
    End With
End Sub

Press Alt+F11 to return to your worksheet.
 

dknowles2004

Board Regular
Joined
Nov 15, 2004
Messages
79
Thanks for you help. If I wanted to do this for multiple columns (eg. D50, F50, H50 etc) can I incorporate this into the code and how?

Thanks.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try this:

Code:
Private Sub Worksheet_Calculate()
    Static OldValues(1 To 3) As Double
    Const ColStep As Integer = 2
    Dim c As Integer
    Dim i As Integer
    c = 1
    With Range("D50")
        For i = LBound(OldValues) To UBound(OldValues)
            If IsEmpty(OldValues(i)) Then OldValues(i) = .Cells(1, c).Value
            If .Cells(1, c).Value < OldValues(i) Then
                .Cells(1, c).Interior.ColorIndex = 3
                .Cells(1, c).Offset(1, 0).Value = "DOWN"
            ElseIf .Cells(1, c).Value > OldValues(i) Then
                .Cells(1, c).Interior.ColorIndex = 10
                .Cells(1, c).Offset(1, 0).Value = "UP"
            End If
            OldValues(i) = .Cells(1, c).Value
            c = c + ColStep
        Next i
    End With
End Sub

To add more columns increase the upper bound of OldValues.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,797
Messages
5,574,366
Members
412,589
Latest member
ArtBOM
Top