Microsoft Office Forums - View Single Post - Place on value in a cell from that time, after 4 hours colour of the cell should change

p45cal · 04-26-2018, 01:13 PM

You can, sort of.
In the attached, there's a range of cells (B2:E13) with a border around that will, more or less, do as you ask.
If you enter or change a value in any of the cells in that range, it will turn green, then conditional formatting is added to turn it red later (10 seconds), BUT it won't change unless:

another cell is changed anywhere on the sheet
the sheet is recalculated
the selection on the sheet changes
the sheet is activated (as in when you've been looking at another tab)

As it stands, any previous conditional formatting will be removed

If you delete the contents of a cell it will have its conditional formatting removed and its colour returned to no fill.

The code in the sheet's code module is:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Set myRng = Intersect(Range("B2:E13"), Target)
If Not myRng Is Nothing Then
  myThen = CDbl(Now() + TimeValue("00:00:10"))
  For Each cll In myRng.Cells
    If Len(cll.Value) > 0 Then
      cll.Interior.Color = 11854022
      With cll.FormatConditions
        .Delete
        .Add Type:=xlExpression, Formula1:="=NOW()>" & myThen
        .Item(1).Interior.Color = 255
      End With
    Else
      cll.FormatConditions.Delete
      cll.Interior.ColorIndex = xlNone
    End If
  Next cll
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = True
End Sub

To change the delay to 4 hours, change the:
TimeValue("00:00:10")
to:
TimeValue("04:00:00")