Flashing Solution

[mpierce]

Thanks to PhilR I found this code to make a flashing cell:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = 55 Then
For n = 1 To 10
Target.Interior.Color = vbRed
Delay (0.04)
Target.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub

Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime < 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub


It works great, but the cell that I want to have flashing contains an if Function: D12=IF(D11>200,"The Pressure is Too High!","") and somehow the flashing only takes place when I actually click on cell D12.

Any ideas about how to rectify this? The code works BEAUTIFULLY! I just want to work out this one small bug!

 

[Damon Ostrander]

Hi mpierce,

You need to use the Calculate event rather than the Change event and modify the code as follows:

Private Sub Worksheet_Calculate()
Dim Target As Range
Set Target = Range("D12") 'D12 is the cell that will flash
If Target.Value = 55 Then
For n = 1 To 10
Target.Interior.Color = vbRed
Delay (0.04)
Target.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub

Keep Excelling.

Damon

 

[Craig92604]

Were does this code go?

 

[mpierce]

Thank you damon!

 

[mpierce]

One more question guys!

Working with this code again:

Private Sub Worksheet_Calculate()
Dim Target As Range
Set Target = Range("D12") 'D12 is the cell that will flash
If Target.Value = 55 Then
For n = 1 To 10
Target.Interior.Color = vbRed
Delay (0.04)
Target.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub

Is there a way that I can select more than one cell for the ones that will potentially flash? So, I want to insert let's say "D1:D22" in place of D12 in the above example.

In other words, what I have is a warning message that can appear in a number of cells if the pressure is above 200, and wherever this warning message appears, I want the error message to in turn flash upon appearing.

Do I need to add a for loop? I think the problem is that in the above code the module no longer takes in any arguments....I am really trying to learn the finer points of how these types of macros are constructed, your help is very greatly appreciated!

 

[Damon Ostrander]

Hi again mpierce,

I believe the following modifications will enable it to work for all cells in a defined range:

Private Sub Worksheet_Calculate()

Dim Target As Range 'Range to be monitored
Dim Frange As Range 'The Target subrange that will flash
Dim C As Range 'A cell within Target range

Set Frange = Nothing
Set Target = Range("D1:D22")

For Each C in Frange
If C.Value = 55 Then
If Frange Is Nothing Then
Set Frange = C
Else
Set Frange = Application.Intersect(Frange,C) 'Add C to Frange
End If
End If
Next C

If Frange Is Nothing Then Exit Sub

'now blink entire Frange
For n = 1 To 10
Frange.Interior.Color = vbRed
Delay (0.04)
Frange.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub

 

[mpierce]

Hi Damon, thanks for getting back to me.

For some reason this does not seem to work. Actually the flashing is not occuring at all now....this is the code exactly that I am trying to use

Private Sub Worksheet_Calculate()

Dim Target As Range 'Range to be monitored
Dim Frange As Range 'The Target subrange that will flash
Dim C As Range 'A cell within Target range

Set Frange = Nothing
Set Target = Range("E4:E12")

For Each C In Frange
If C.Value = "The Pressure is Too High!" Then
If Frange Is Nothing Then
Set Frange = C
Else
Set Frange = Application.Intersect(Frange, C) 'Add C to Frange
End If
End If
Next C

If Frange Is Nothing Then Exit Sub

'now blink entire Frange
For n = 1 To 10
Frange.Interior.Color = vbRed
Delay (0.04)
Frange.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub


Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime < 0.01 Or rTime > 1000 Then rTime = 1
oldTime = Timer
Application.Calculate
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub

I get an "end if with no if statement" error, and after commenting out the end if at the conclusion of the first segment of code then nothing happens.

Also, when I try using just one cell still (such as E4), it still does not work.

Is there an If missing? I am trying to see if there is right now.....

 

[Damon Ostrander]

Hi again mpierce,

I made several mistakes, the most important being that I used Intersect rather than Union.

Here is the corrected code:

Private Sub Worksheet_Calculate()

Dim Target As Range 'Range to be monitored
Dim Frange As Range 'The Target subrange that will flash
Dim C As Range 'A cell within Target range

Set Frange = Nothing
Set Target = Range("E4:E12")

For Each C In Target
If C.Value = "The Pressure is Too High!" Then
If Frange Is Nothing Then
Set Frange = C
Else
Set Frange = Application.Union(Frange, C) 'Add C to Frange
End If
End If
Next C

If Frange Is Nothing Then Exit Sub

'now blink entire Frange
For n = 1 To 10
Frange.Interior.Color = vbRed
Delay (0.04)
Frange.Interior.ColorIndex = xlNone
Delay (0.04)
Next n

End Sub


Give this one a spin.

Damon

 

[mpierce]

Perfect! Thank you thank you thank you thank you!