Option Explicit
Private Const FLASHING_CELL = "Sheet2!A1" '<<= change cell addrss to suit.
Private Const PEAK_VALUE = 150 '<<= change value to suit.
Private dblPreVal As Double
Private bFlashing As Boolean
Private Sub Workbook_Activate()
bFlashing = False
dblPreVal = Range(FLASHING_CELL)
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If Sh Is Range(FLASHING_CELL).Parent Then
With Range(FLASHING_CELL)
If VarType(.Value) = vbDouble Then
Select Case True
Case (.Value >= PEAK_VALUE) And (dblPreVal < PEAK_VALUE) And bFlashing = False
Call FlashCell(Range(FLASHING_CELL), vbGreen)
Case (.Value < PEAK_VALUE) And (dblPreVal >= PEAK_VALUE) And bFlashing = False
Call FlashCell(Range(FLASHING_CELL), vbRed)
End Select
dblPreVal = .Value
End If
End With
End If
End Sub
Private Sub FlashCell(ByVal Cell As Range, ByVal lColor As Long)
Dim t As Single, lInitColor As Long
On Error GoTo Xit
Application.EnableCancelKey = xlErrorHandler
Beep
t = Timer
With Cell
lInitColor = .Interior.ColorIndex
Do While Timer - t <= 4
bFlashing = True
DoEvents
If Int(Timer) Mod 2 Then
.Interior.Color = lColor
Else
.Interior.ColorIndex = lInitColor
End If
Loop
Xit:
.Interior.ColorIndex = lInitColor
bFlashing = False
End With
End Sub