• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to get more than one flash?

Eloise T

Active Member
I would like the macro "StartFlashing" to cause any cell in Column K to flash if it contains the Unicode U221A which is the square root symbol (). Currently all Column K cells are blinking once by simply changing color, not really flashing. Thank you in advance for any assistance.

Hopefully this is simpler and cleaner: Please see attachment.

Code:
Sub StartFlashing()
    Dim Ws As Worksheet
    Dim xCell As Range
        For Each Ws In ThisWorkbook.Worksheets
    Set xCell = Range("K3:K60")
'    With ThisWorkbook.Worksheets("Paul", "Matt", "Marc").Range("K3:K60").Font
    With ThisWorkbook.Worksheets
    If xCell.Font.Color = vbGreen Then
            xCell.Font.Color = vbBlue
        Else
            xCell.Font.Color = vbGreen
        End If
    End With
    Next

    xTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime xTime, "StartFlashing", , True
End Sub
Sub StopFlashing()
    Application.OnTime xTime, "StartFlashing", , False
End Sub
 

Attachments

  • Imitate flashing IV.xlsm
    467 KB · Views: 8
Seems fine but you should move the code to a Module and uncomment your Public xTime.


The problem is the color changes from Green to Blue but I have to run the macro each time for the color to change once AND I get the following error message after the color changes. ...and the Public xTime doesn't seem to make a difference either active or commented out.

upload_2018-7-5_13-29-4.png
 
I'm trying to get the flashing to work properly first (continuous flashing), then try to figure out how to put the following into the macro.
Code:
With ws.Range("K3:K100")
            .FormatConditions.Add Type:=xlExpression, Formula1:="=IF($K3=UNICHAR(221A)"
End With
 
Last edited:
Mine flashes the whole range. The color left after a run depending on the time interval.

I will look at a more specific cell flashing based on the character and the format deal later since this computer only has 2010.

As for the macro error, I guess it would not run if macros were disabled. It would error too if you used Application.Run() and that workbook was not open.

Tip: Use Option Explicit as first line of code in all Modules, sheets and such. That way, a Compile can catch undeclared variables. You will need the Public variable.

Keep in mind, that moving to another sheet, can really affect how OnTime() works.

I put two buttons on the first sheet to make testing easier.
 

Attachments

  • Imitate flashing IV.xlsm
    439 KB · Views: 3
This one checks for the character and only "flashes" between the two font colors.

You might want to add a more dynamic range to "flash" and/or add a feature to reset all font colors to restore font colors to "non-flash" status.

Note how I checked for the character. You can add that in your format formula maybe...

Code:
Public xTime As Double

Sub StartFlashing()
  Dim Ws As Worksheet, xCell As Range, c As Range
   
  For Each Ws In ThisWorkbook.Worksheets
    Set xCell = Ws.Range("K3:K60")
    For Each c In xCell
      'UNICHAR(Hex2Dec("221A")) = UniChar(8730) 'UniChar() in Excel 2013 and up.
      If c = WorksheetFunction.Unichar(8730) Then
        If c.Font.Color = vbGreen Then
          c.Font.Color = vbBlue
          Else
          c.Font.Color = vbGreen
        End If
      End If
    Next c
  Next Ws

  xTime = Now + TimeSerial(0, 0, 1)
  Application.OnTime xTime, "StartFlashing", , True
End Sub

Sub StopFlashing()
  Application.OnTime xTime, "StartFlashing", , False
End Sub
 

Attachments

  • Imitate flashing V.xlsm
    468.5 KB · Views: 3
Hi !

WorksheetFunction.Unichar(8730) is the same as standard

VBA function ChrW(8730) working whatever the Excel version …
 
Thank you Kenneth and Marc.

xTime = Now + TimeSerial(0, 0, 1) sets the time interval, correct?

I wanted to make it "flash" a bit faster so I changed the above line to:

xTime = Now + TimeSerial(0, 0, 0.5) and now it flashes unacceptably crazy.
How can I set it somewhere in between too slow and faster than a speeding bullet?
 
Good suggestion. I tried .9, .8, .7, and .6. .5 is when it went crazy and had to use Task Manager to halt the process. How could the VBA be modified to make it "linger" longer for vbRed than the "off" cycle of RGB(238, 236, 225)? Please see attachment. Many thanks.
 

Attachments

  • Imitate flashing V.xlsm
    466.4 KB · Views: 2
Last edited:
TimeSerial() will give you 0 days or 1 second day. 0.5 seconds in it gives 0 seconds, ergo your fast flashing.

You should be able to fractionate the day more like this:
Code:
Dim t as double
t = CDbl(TimeSerial(0, 0, 1)) / 2
t= TimerSerial(0,0,1)
xTime = Now + t
You can add a boolean variable and set to True in the If() if there a condition meets the check for a red checkmark. If False, the 2nd t value would apply.

The end timer should maybe reset the range font color to a default color maybe.

For just a few cells, the each cell loop should be fine. For many, I would add a full Find() method so I could set all font colors at once rather than one at a time.
 
TimeSerial() will give you 0 days or 1 second day. 0.5 seconds in it gives 0 seconds, ergo your fast flashing.

You should be able to fractionate the day more like this:
Code:
Dim t as double
t = CDbl(TimeSerial(0, 0, 1)) / 2
t= TimerSerial(0,0,1)
xTime = Now + t
You can add a boolean variable and set to True in the If() if there a condition meets the check for a red checkmark. If False, the 2nd t value would apply.

The end timer should maybe reset the range font color to a default color maybe.

For just a few cells, the each cell loop should be fine. For many, I would add a full Find() method so I could set all font colors at once rather than one at a time.
I found an extra character that I had to yank out in the TimerSerial line. o_O
It appears that it's working for the sanitized file (see attachment) but when inserted in the "real" file, I get:

upload_2018-7-10_14-21-4.png
upload_2018-7-10_14-25-52.png

SANITIZED VERSION:

Code:
Public xTime As Double
Sub StartFlashing()
    Dim Ws As Worksheet, xCell As Range, c As Range, t As Double
'  This VBA causes a cell in Column K to flash if it contains the Unicode U221A which is the square root symbol.'  This VBA causes a cell in Column K to flash if it contains the Unicode U221A which is the square root symbol.
    For Each Ws In ThisWorkbook.Worksheets
        Set xCell = Ws.Range("K3:K6005")
        For Each c In xCell
'          UniChar(Hex2Dec("221A")) = UniChar(8730)
'          UniChar(Hex2Dec("nnnn")) in Excel 2010 and below
'          UniChar(nnnn) in Excel 2013 and up.
            If c = WorksheetFunction.Unichar(8730) Then
                If c.Font.Color = vbRed Then
                    c.Font.Color = RGB(238, 236, 225)
                Else
                    c.Font.Color = vbRed
                End If
            End If
        Next c
    Next Ws

    t = CDbl(TimeSerial(0, 0, 1)) / 2
'   t = TimerSerial(0, 0, 1)
    t = TimeSerial(0, 0, 1)
    xTime = Now + t

'    xTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime xTime, "StartFlashing", , True
End Sub

UNSANITIZED VERSION:
Code:
#If Win64 Then
  Private Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#Else
  Private Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#End If

Sub DemokBeep()
'  G  C  E  G  E  G
  FD = [{196,200;262,200;330,200;392,400;330,225;392,975}]  'Charge! see:

  For L& = 1 To UBound(FD):  kBeep FD(L, 1), FD(L, 2):  Next
End Sub



'Option Explicit
Public xTime As Double
Sub StartFlashing()
  Dim Ws As Worksheet, xCell As Range, c As Range, t As Double
'  This VBA causes a cell in Column K to flash if it contains the Unicode U221A which is the square root symbol.'  This VBA causes a cell in Column K to flash if it contains the Unicode U221A which is the square root symbol.
  For Each Ws In ThisWorkbook.Worksheets
  Set xCell = Ws.Range("K3:K6005")
  For Each c In xCell
'  UniChar(Hex2Dec("221A")) = UniChar(8730)
'  UniChar(Hex2Dec("nnnn")) in Excel 2010 and below
'  UniChar(nnnn) in Excel 2013 and up.
  If c = WorksheetFunction.Unichar(8730) Then
  If c.Font.Color = vbRed Then
  c.Font.Color = RGB(238, 236, 225)
  Else
  c.Font.Color = vbRed
  End If
  End If
  Next c
  Next Ws


  t = CDbl(TimeSerial(0, 0, 1)) / 2
  t = TimeSerial(0, 0, 1)
  xTime = Now + t

'  xTime = Now + TimeSerial(0, 0, 1)
  Application.OnTime xTime, "StartFlashing", , True
End Sub

Public Sub StopFlashing()
  Application.OnTime xTime, "StartFlashing", , False
End Sub

There's got to be something simple here I'm overlooking.
Thanks for your assistance!
 

Attachments

  • upload_2018-7-10_14-25-11.png
    upload_2018-7-10_14-25-11.png
    15.1 KB · Views: 2
  • Imitate flashing V.xlsm
    466.6 KB · Views: 6
Last edited:
Though I hate to assist anyone to create flashing cells, your code should not be in the ThisWorkbook module.
 
Put in Module as explained so it is Public.

If you meant why hate to assist, likely because flashing causes some people to have epileptic seizures even if their eyes just get a glimpse over your shoulder. Good thing my dogs don't get those. I have flashing lights going on all the time around my computer at home. One dog does get spooked by them...
 
Put in Module as explained so it is Public.

If you meant why hate to assist, likely because flashing causes some people to have epileptic seizures even if their eyes just get a glimpse over your shoulder. Good thing my dogs don't get those. I have flashing lights going on all the time around my computer at home. One dog does get spooked by them...

I did. Please look at VBA code above. I'm wondering if all the other Subs in the code above are affecting the "flashing" code and that there is some mysterious protocol that needs to be maintained I order for everything to work?
 
Why does your picture indicate that everything is in ThisWorkbook when actually nothing is (at least in the workbook you posted)?
 
As long as the code is in a normal module, not called "StartFlashing", and macros are enabled, you shouldn't get the error message you cited.
 
Back
Top