Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changed As Range, cell As Range
    Dim previousEvents As Boolean, failure As String
    Set changed = Intersect(Target, Me.Range("B2:B500"))
    If changed Is Nothing Then Exit Sub
    previousEvents = Application.EnableEvents
    On Error GoTo Failed
    Application.EnableEvents = False
    For Each cell In changed.Cells
        If IsError(cell.Value2) Then
            cell.Offset(0, 1).ClearContents
            cell.Interior.ColorIndex = xlColorIndexNone
        ElseIf Len(CStr(cell.Value2)) = 0 Then
            cell.Offset(0, 1).ClearContents
            cell.Interior.ColorIndex = xlColorIndexNone
        Else
            cell.Offset(0, 1).Value = Now
            cell.Offset(0, 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
            If IsNumeric(cell.Value2) Then
                If CDbl(cell.Value2) < 5 Then
                    cell.Interior.Color = RGB(255, 200, 200)
                Else
                    cell.Interior.ColorIndex = xlColorIndexNone
                End If
            Else
                cell.Interior.ColorIndex = xlColorIndexNone
            End If
        End If
    Next cell
CleanUp:
    Application.EnableEvents = previousEvents
    If Len(failure) > 0 Then MsgBox "Stopped; some cells may already be updated. " & failure, vbExclamation
    Exit Sub
Failed:
    failure = CStr(Err.Number) & ": " & Err.Description
    Resume CleanUp
End Sub
