Do While loop to blink cell every second is killing performance

Question

I wrote a macro to check if a date is the last day of a month.
If so this cell should blink every 1 second, so I'm calling a Do While loop.

I want to start the Sub when I open the worksheet, so I added a Sub Workbook_Open(). If the date is the last day of the month this sub is called as expected.

Private Sub Workbook_Open()
    Call CellBlink
End Sub

The performance is so bad, that it is nearly impossible to work with this sheet.

Do While Today = EndOfMonth

    CellThatBlinks.Interior.ColorIndex = 3
    Application.Wait (Now + TimeValue("0:00:01"))

    CellThatBlinks.Interior.ColorIndex = 0
    Application.Wait (Now + TimeValue("0:00:01"))

    CellThatBlinks.Interior.ColorIndex = 3

    DoEvents

Loop

Answer 1

Using Application.OnTime is a way to loop without blocking execution.

First Name the cell in the Workbook that you want to blink, eg "BlinkCell", using Formulas / Define Name.

Then put this code in a Module (not a Workbook or Worksheet object):

Option Explicit
Dim strLast As String

Public Sub CellBlink()
    Dim rngBlink As Range
      
    If WorksheetFunction.EoMonth(Now, 0) = Int(Now) Then
        Set rngBlink = Range("BlinkCell")
        
        Dim onIndex, offIndex
        onIndex = 3
        offIndex = 0
        
        If rngBlink.Interior.ColorIndex = onIndex Then
            rngBlink.Interior.ColorIndex = offIndex
        Else
            rngBlink.Interior.ColorIndex = onIndex
        End If
        
        strLast = Format(Now + TimeValue("00:00:01"), "hh:mm:ss")
        Application.OnTime strLast, "CellBlink"
    End If
End Sub

Public Sub CancelBlink()
    If Len(strLast) > 0 Then
        Application.OnTime strLast, "CellBlink", Schedule:=False
        Range("BlinkCell").Interior.ColorIndex = 0
    End If
End Sub

and this code in the ThisWorkbook object:

Option Explicit

Private Sub Workbook_Open()
    CellBlink
End Sub

Private Sub Workbook_BeforeClose(Cancel as Boolean) 
    CancelBlink
End Sub

How it works: Once the Workbook_Open event is fired, the global subroutine CellBlink is called. In the sheet, the blinking cell is Name'd "BlinkCell". CellBlink checks whether today's date is the end of month: if it is then the cell colour is toggled (on->off->on etc). Finally, the Application.OnTime function is called to run this same CellBlink macro in one second's time. The time that the macro is schedule to run is saved as a string. Running the CancelBlink macro will terminate the loop until CellBlink is called again.