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!

 

[AntMac]

Sounds like this would be easiest through conditional formatting. Just make sure you add a condition to return it back. Have you tried this and it didn't work?

 

[AntMac]

I just read it again. You could put a routine under the selection change - Worksheet_SelectionChange(ByVal Target As Range) and get the current value as a variable. Then compare to the new value after the change on the worksheet change routine. Only thing is to get it all to work, you might want to end the change route making sure the cell isn't selected. And make sure either with an on open or worksheet activate un select the cell. Let me know if you need more details than that.

 

[jayden13]

Sounds like this would be easiest through conditional formatting. Just make sure you add a condition to return it back. Have you tried this and it didn't work?

I have not been able to identify a way to conditionally format a cell based on the same cell's previous values. I want the color of the cell to change based on an increase/decrease in value within the same cell rather than the value itself, if that makes sense?

 

[jayden13]

I just read it again. You could put a routine under the selection change - Worksheet_SelectionChange(ByVal Target As Range) and get the current value as a variable. Then compare to the new value after the change on the worksheet change routine. Only thing is to get it all to work, you might want to end the change route making sure the cell isn't selected. And make sure either with an on open or worksheet activate un select the cell. Let me know if you need more details than that.

Thank you for your follow up! If you are able to provide more details, it would be greatly appreciated as I am fairly new to VBA.

 

[AntMac]

Actually this was easier than I thought. What you need are 2 macros. One on the opening of the workbook and one on the change of the worksheet with A1. For now I'm going to use Sheet2 as that worksheet.

1. On your file show the VBA
2. In the VBA for the file select insert - Module
3. Double click on the module1 that opened.
4. In that area add
Public old1 As Integer
Public new1 As Integer
5. Double click on This workbook on the pain on the left.
6. On the right pain add this statement in the Workbook_open sub
old1 = Worksheets.Sheet2.Range("A1").Value
7. Double click on sheet2 on the pain on the left.
8. in the first drop down on the right select worksheet.
9. in the Wosheet_change sub add this code:

Application.EnableEvents = False
sAddr = Target.Address(False, False)
If sAddr = "A1" Then
new1 = Target.Value
If new1 > old1 Then
With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
Else
With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End If
old1 = new1
Else

End If
Application.EnableEvents = True

 

[AntMac]

A couple of things to note. 1. is the Sheet2 should be the name of the worksheet that has A1 which you want to see if it changed. 2. You didn't say what you wanted to do if the value is the same. Right now that's in the else bucket so it will be red.

 

[jayden13]

Actually this was easier than I thought. What you need are 2 macros. One on the opening of the workbook and one on the change of the worksheet with A1. For now I'm going to use Sheet2 as that worksheet.

1. On your file show the VBA
2. In the VBA for the file select insert - Module
3. Double click on the module1 that opened.
4. In that area add
Public old1 As Integer
Public new1 As Integer
5. Double click on This workbook on the pain on the left.
6. On the right pain add this statement in the Workbook_open sub
old1 = Worksheets.Sheet2.Range("A1").Value
7. Double click on sheet2 on the pain on the left.
8. in the first drop down on the right select worksheet.
9. in the Wosheet_change sub add this code:

Application.EnableEvents = False
sAddr = Target.Address(False, False)
If sAddr = "A1" Then
new1 = Target.Value
If new1 > old1 Then
With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
Else
With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End If
old1 = new1
Else

End If
Application.EnableEvents = True

Thank you! However when I get to #8 I get "Compile error - Invalid outside procedure" when I try to select "Worksheet".

If there is no change, I would like the cell to remain with no fill.

 

[AntMac]

That's weird. All I can think of is if you have more than one file open make sure you are on the right file on the left.

 

[Peter_SSs]

Welcome to the MrExcel board!

I am guessing that you might want this procedure to apply to more than just one cell and have allowed for that. For my example I have used the range A1:A5 so any cell in that range will get coloured depending on the change. If the same number is re-entered in the cell, colour will be removed from the cell (this behaviour can be changed)
If it is really only one cell, this will still work.

Try these steps in a copy of your workbook that does not have any of the code suggested by AntMac in it.

1. Insert a new worksheet into your workbook and change the tab name to Copy
2. Copy the relevant range (A1:A5 for me) and paste into exactly the same place in the 'Copy' sheet.
3. Right-click on the name tab of your main sheet where you want the colour to happen and choose 'View Code'
4. Copy the code below and paste it into the main right hand pane that opens at step 3.
5. Go back to your main sheet and try changing values in the target range.

If you want, you can hide that 'Copy' sheet. Right-click its name tab and choose 'Hide'

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, cell As Range
  Dim CellColr As Long
  
  Const MyTargetRange As String = "A1:A5" '<- Change this if required
  
  Set Changed = Intersect(Target, Range(MyTargetRange))
  If Not Changed Is Nothing Then
    For Each cell In Changed
      Select Case cell.Value - Sheets("Copy").Range(cell.Address).Value
        Case Is > 0: CellColr = RGB(146, 208, 80)
        Case Is < 0: CellColr = RGB(255, 0, 0)
        Case Else: CellColr = xlNone
      End Select
      cell.Interior.Color = CellColr
      Sheets("Copy").Range(cell.Address).Value = cell.Value
    Next cell
  End If
End Sub