FLASHING FONT CODE VERY BUGGY, PLEASE FIX

[Noir]

The code below works fairly well but, the problem is once the code starts running it's almost impossible to close your workbook. The only way i have found to close is to click "Pause" from within the VB edit window, then close out of the workbook.

Please look at this code and see if you can correct any problems.

Here is the code;

Placed in a new Module:

Sub Flash()
NextTime = Now + TimeValue("00:00:01")
With Cells(9, 8).Font
If .ColorIndex = 2 Then .ColorIndex = 3 Else .ColorIndex = 2
End With
Application.OnTime NextTime, "Flash"
End Sub

Sub StopIt()
Application.OnTime NextTime, "Flash"
Application.OnTime NextTime, "Flash", Schedule:=False
Cells(9, 8).Font.ColorIndex = xlAutomatic
End Sub




Placed in This Workbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Calculate
If Cells(9, 8).Value > 0 Then
Flash
Else
StopIt
End If

End Sub


Thx,
Noir

 

[Noir]

Thanks for all the suggestions guys, i got some great info here.

Unfortunately, my problem of not being able to close my workbook while the code is running (without running stop code) still exists. The problem is, my users will not want to/be able to go in and run stop code. I use the code to reiterate important pieces of information to my users. I know i could use a million different methods to accomplish this but, i just like the idea of perpetually flashing text.

Noir

 

[flightjock]

I use the following code originally supplied by Joe Was with much succes:

Sub FlashFont()
'Joe Was
'Make cell range font flash, x times, x fast, in x color,
'when Ctrl-z is pressed.
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed

'Make this cell range font flash!
Set myCell = Range("N1:N2")
Application.DisplayStatusBar = True
Application.StatusBar = "... Select Cell to Stop and Edit or Wait for Flashing to Stop! "

'Make cell font flash to this color!
'Black 25, Magenta 26, Yellow 27, Cyan 28, Violet 29, Dark Red 30,
'Teal 31, Blue 32, White 2, Red 3, Light Blue 41, Dark Blue 11,
'Gray-50% 16, Gray-25% 15, Bright Cyan 8.

newColor = 3

'Make the cell range flash fast: 0.01 to slow: 0.99
fSpeed = 0.1

'Make cell flash, this many times!
Do Until x = 20

'Run loop!
DoEvents
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = newColor
Loop
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Font.ColorIndex = 2
Loop
x = x + 1
Loop
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
End Sub


Success!

Tony

 

[tusharm]

Thanks for all the suggestions guys, i got some great info here.

Unfortunately, my problem of not being able to close my workbook while the code is running (without running stop code) still exists. The problem is, my users will not want to/be able to go in and run stop code. I use the code to reiterate important pieces of information to my users. I know i could use a million different methods to accomplish this but, i just like the idea of perpetually flashing text.

Noir

Good point. Introduce a Workbook_BeforeClose procedure in the Workbook module. In my example, it would include a call to the EndProcess routine. Depending on what solution you finally settle on you would have to call the appropriate routine.

Note that except for two solutions (Bill Manville's and mine), every other solution requires changing the code to decide which cells blink. Bill's solution works around that problem with the Flash style, but it too requires changing the code to change the 'on' and 'off' formats.

The downside with my 'metronome' code is that it uses up one conditional format and it recalculates the worksheet (something that the others may or may not require).

 

[Noir]

Tusharm,
All things considrered, i think your Conditional Formatting method will probably fit my needs the best. Thanks

Thanks again to everyone who contributed.

Noir

 

[NateO]

To tack on briefly, and as Tushar mentioned, recalcing every cell, every second may not be desirable. Bill's procedure will not recalculate the sheet, which is why counting colour udf's can be temperamental, font format changes do not inspire Excel to recalculate. Not trying to take away from Tushar's solution just agreeing with some critical thoughts he's already mentioned.

Either way, agree with Tushar, use the event to cancel to call StopIt() or the other cancel proc. If you make these subs private, use:

Application.Run "StopIt"

Also, what I didn't do, and what I would recommend is to define the sheet associated with the range, e.g.,

sheets(1).[h9]

So it won't act on the active sheet.

 

[tusharm]

OK, that's been bugging me. The 'keep up the beat' solution seems too darn good to be thrown away because of performance issues. [OK, so no one ever said I was modest {vbg}]

Instead of forcing a recalculation, how about something seemingly benign like replacing the Application.Calculate with

ActiveWorkbook.Styles("normal").NumberFormat = _
    ActiveWorkbook.Styles("normal").NumberFormat

The reason I like this metronome solution is that by removing all the content and format control from the VBA code, it leads to a magnitude increase in flexibility. One could have some cells change format on a two second cycle, others on a three second cycle. The change in format could be a 'blinking' effect, or a border on-off effect or whatever one's imagination can come up with.

Go crazy and have one set of cells alternate between red and white, while another set goes green or blue. That will give the user a nice fat headache rather quickly.

Or, get more creative...in A1:A10 enter an asterisk (SHIFT + 8). Format the cells so that the font is White (strictly speaking, it should be the same as the background). Now, add one conditional format. Use Formula Is and set the formula to =(MOD(SECOND(NOW())-1,10)+1)=ROW(). Set the associated format to a font color = Red. Turn on the timer, and it will look like the asterisk moves down from row 1 to row 10, one step each second, and then restarts the cycle in row 1.

 

[Noir]

I like the alternating row idea, Very slick Tusharm. I actually replaced the "*" with a right arrow (Alt-16, formatted as Arial, font size 10). Looks neat. Still can't close WB without running "Endprocess" code but, looks neat.

Noir

 

[Noir]

PS,
I applied =(MOD(SECOND(NOW())-1,10)+1)=ROW() to column B, formated as Red font and copied down. Now, the arrow in A1:A10 cycles down the column in Red and the text in B1:B10 highlights as Red simultaneously, looks GREAT!!

Noir