Auto on/off blink cells

Copper Contributor

Hi! I have been banging my head on my desk for several days now trying to make any of 3 cells blink in a worksheet when a specific criteria has been me.

 

Brief synopsis:

 

One worksheet (WS1) automatically feeds data to another (WS2) in cells A23, A31, and A39 of WS2. When a specific text appears in any one of 3 cell in WS2, I would like the cell to blink. The criteria is "PARTS". When it appears in any one of those 3 cells, I would like it to blink red and white. If it does not equal "PARTS", I would like the cells to remain white. I would like this to run automatically when WS2 is opened, based on the current condition being met or not. Please see below for code being used. I believe I am missing how to properly link them through nesting, as I can get one to blink in the current code shown, but not the other two cells. Thanks!

 

Option Explicit

Sub BlinkCell()
Dim CellToBlink As Range

Set CellToBlink = Range("A23")
If Range("A23").Value = "PARTS" Then
Do While Range("A23").Value = "PARTS"
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents

If Range("A23").Value <> "PARTS" Then
CellToBlink.Interior.Color = vbWhite
End If

Loop

If Range("A31").Value = "PARTS" Then
Set CellToBlink = Range("A31")
Do While Range("A31").Value = "PARTS"
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents

If Range("A31").Value <> "PARTS" Then
CellToBlink.Interior.Color = vbWhite
End If

Loop

If Range("A39").Value = "PARTS" Then
Set CellToBlink = Range("A39")
Do While Range("A39").Value = "PARTS"
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents

If Range("A39").Value <> "PARTS" Then
CellToBlink.Interior.Color = vbWhite
End If

Loop

End If
End If
End If

End Sub

15 Replies

@BBowen6501 

I think making a cell blink is not a good idea:

  • It becomes annoying very quickly.
  • It can be dangerous to users who are susceptible to seizures.

Moreover, using Application.Wait makes Excel completely unresponsive.

It's better to draw attention to a cell by using a striking combination of text color, fill color and perhaps cell borders.

 

@Hans Vogelaar 

 

Thank you for your concern, but I truly do need this to work as needed to make this form as simple for 1 or 2 other users as possible. 

reconfigure your macro to do the "loop" only once setting all of the corresponding cells you want to blink to the range you are 'blinking'. you can either use a Union operator or when defining the Range("cell1, cell2").

PS- I completely agree with Hans that this isn't a preferred method for a number of reasons.  For me I agree with performance issue (but only a couple blinks shouldn't be too bad) but more so because if they don't see those couple of flashes then what? Also, this solution requires macros which means if they don't enable macros or go to excel online it doesn't work.

I agree bright RED cells with BOLD YELLOW Font or the such is better in the long run.

Okay. I tried comma separation before, which did make all 3 cells blink, but it disregarded the "PARTS" condition and just blinked them all anyway. Simply use an & between range defs?
Is there an "Or" union option to use here so they work independently of one another?
I was thinking something like:
cells2blink=""
If Range("A23").Value = "PARTS" Then
cells2blink=cells2blink & "A23, "
end if
If Range("A31").Value = "PARTS" Then
cells2blink=cells2blink & "A31, "
end if
If Range("A39").Value = "PARTS" Then
cells2blink=cells2blink & "A39, "
end if
if LEN(cells2blink)>1 then
cells2blink=Left(cells2blink, LEN(cells2blink)-2)
Set CellToBlink = Range(cells2blink)
cont with blink...
Still no luck.
This is making cell A23 work, though.

Sub BlinkCell()
Dim CellToBlink As Range
If Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS" Then
Set CellToBlink = Range("A23")
Do While Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS"
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents
Loop
If Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS" Then
Set CellToBlink = Range("A31")
Do While Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS"
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents
Loop
If Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS" Then
Set CellToBlink = Range("A39")
Do While Range("A23").Value = "PARTS" Or Range("A31").Value = "PARTS" Or Range("A39").Value = "PARTS"
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("00:00:01"))
CellToBlink.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents
Loop

End If
End If
End If

End Sub

@BBowen6501 

If you really really want this, see the attached sample workbook. There is code in ThisWorkbook and in Module1. Both are required.

@Hans Vogelaar 

 

Bold item near bottom is tripping "Variable not defined" compile error. Please advise. Thanks!

 

Sub ManageBlink()
Dim rng As Range
For Each rng In Worksheets("CI").Range("A23,A31,A39")
With rng
If .Value = "PARTS" Then
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = 0
Else
.Interior.ColorIndex = 0
End If
End If
End With
Next rng
dtmNext = DateAdd("s", 1, Now)
Application.OnTime dtmNext, "ManageBlink"
End Sub

One moment. Forgot second piece. Sorry.
Nope. Still no dice.

@BBowen6501 

Does the sample workbook that I attached work for you?

Macros disallowed from outside source, so copy and pasted into mine with necessary changes to sheet names. That's it.

@BBowen6501 

You must have made a mistake somewhere - I have tested the code and it is working correctly in the sample workbook.

Check very carefully.