"Blinking" Cell

Question

I would like to have the active cell in a spreadsheet "blink" by alternating the Interior.Colorindex between "no fill" (e.g., index = -4142) and another fill color of my choice (e.g., bright yellow/color index=6).  I would like this "blinking" to occur at half-second intervals and continue until another cell in the spreadsheet is selected, at which time the newly-selected cell begins "blinking" and the previous "blinking" cell stops with its Interior.Colorindex set at my chosen fill color.

Thanks in advance for any suggestions on how to accomplish this.

Answer 1

First, blinking cells is not always a wise choice - blinking at certain rates can induce an epilepsy attack in some people.  With that warning in hand, here you go.

This is one of those solutions that needs code in 3 different places:  worksheet event code, workbook event code and a regular code module.  You can find instructions for working with each of those areas on this page:

http://www.contextures.com/xlvba01.html

First - The ThisWorkbook event code - you need this to make sure the process is turned off if you work with another workbook and/or when you close the workbook:

Private Sub Workbook_Deactivate()

  Run "StopBlinking"

End Sub

Second the Worksheet event code:

Private Sub Worksheet_Change(ByVal Target As Range)

  Run "StopBlinking"

  Set cellToBlink = Target

  Run "StartBlinking"

End Sub

And finally the regular code module code:

Public NextBlink As Double

'The cell that you want to blink

Public cellToBlink As Range

'Start blinking

Private Sub StartBlinking()

    If cellToBlink Is Nothing Then

      StopBlinking

      Exit Sub

    End If

    'If the color is red, change the color and text to white

    If cellToBlink.Interior.ColorIndex = 6 Then

        cellToBlink.Interior.ColorIndex = xlNone

    Else

        cellToBlink.Interior.ColorIndex = 6

    End If

    'Wait one second before changing the color again

    NextBlink = Now + TimeSerial(0, 0, 1)

    Application.OnTime NextBlink, "StartBlinking", , True

End Sub

'Stop blinking

Private Sub StopBlinking()

    'Set color to white

    If Not cellToBlink Is Nothing Then

      cellToBlink.Interior.Color = xlNone

    End If

    On Error Resume Next

    Application.OnTime NextBlink, "StartBlinking", , False

    Err.Clear

    On Error GoTo 0

End Sub

Answer 2

Thanks bunches.