Flashing Cell

  • Thread starter Thread starter deepak
  • Start date Start date
D

deepak

Hello Again!

Can we have a cell flashing in , say red, color when it meets certain
criteria.
Say, A1 = be any date and B1 = today(). And, if B1 exceeds A1 then it start
to flash.

e.g. A1 = 7-sep-09 and B1=8-Sep-09, since B1 exceeded A1, it starts to flash.

Please forgive me if I am expecting a lot.

Thanks.
 
Flashing cells are possible using VBA event code only.

Flashing cells are also very annoying and may be illegal in some
jurisdictions due to them possibly inducing Epileptic episodes in sensitive
persons.


Gord Dibben MS Excel MVP
 
Try this sample

---------------------------------------------


Public Const TextToFind = "Under Process"

Public RunWhen As Double

Sub StartBlink()
Dim LopX As Long
Dim LopY As Long

On Error Resume Next
For LopX = 1 To 15
For LopY = 1 To 100
If InStr(Trim(LCase(Cells(LopY, LopX))), LCase(TextToFind)) > 0
Then
If Cells(LopY, LopX).Font.Color = vbRed Then
Cells(LopY, LopX).Font.Color = vbBlack
Else
Cells(LopY, LopX).Font.Color = vbRed
End If
End If
Next
Next
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,
True
Err.Clear
End Sub


Sub StopBlink()
Dim LopX As Long
Dim LopY As Long

On Error Resume Next
For LopX = 1 To 15
For LopY = 1 To 100
If InStr(Trim(LCase(Cells(LopY, LopX))), LCase(TextToFind)) > 0
Then
Cells(LopY, LopX).Font.Color = vbBlack
End If
Next
Next
RunWhen = 0
Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,
False
Err.Clear
End Sub
 
try this

--------------------------

Public Const TextToFind = "Under Process"

Public RunWhen As Double

Sub StartBlink()
Dim LopX As Long
Dim LopY As Long

On Error Resume Next
For LopX = 1 To 15
For LopY = 1 To 100
If InStr(Trim(LCase(Cells(LopY, LopX))), LCase(TextToFind)) > 0
Then
If Cells(LopY, LopX).Font.Color = vbRed Then
Cells(LopY, LopX).Font.Color = vbBlack
Else
Cells(LopY, LopX).Font.Color = vbRed
End If
End If
Next
Next
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,
True
Err.Clear
End Sub


Sub StopBlink()
Dim LopX As Long
Dim LopY As Long

On Error Resume Next
For LopX = 1 To 15
For LopY = 1 To 100
If InStr(Trim(LCase(Cells(LopY, LopX))), LCase(TextToFind)) > 0
Then
Cells(LopY, LopX).Font.Color = vbBlack
End If
Next
Next
RunWhen = 0
Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,
False
Err.Clear
End Sub
 
Back
Top