Flashing animation getting interrupted by DoEvents

Question

I have written some simple code in Excel VBA, to make a range "flash" a colour - this is achieved by carefully drawing a rectangle object over the range in question, and varying its transparency to make the box fade gradually.

Here's the code (in Sheet1 for the Worksheet_Change event):

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub flashBox(ByVal area As Range, Optional ByVal fillColour As MsoRGBType = vbGreen)

    Const animationSeconds As Single = 0.5
    Const animationSteps As Long = 20

    With area.Worksheet.Shapes.AddShape(msoShapeRectangle, area.Left, area.Top, _
                                        Application.WorksheetFunction.Min(area.Width, 1000), _
                                        Application.WorksheetFunction.Min(area.Height, 1000)) 'stop infinite boxes, could use view area to define this
        .Line.Visible = msoFalse
        .Fill.ForeColor.RGB = fillColour
        Dim i As Long
        For i = 1 To animationSteps
            Sleep animationSeconds * 1000 / animationSteps
            .Fill.Transparency = i / animationSteps
            DoEvents 'screen repaint
        Next i
        .Delete
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    flashBox Target, ColorConstants.vbMagenta
End Sub

I use a With block to contain the temporary object without a parent variable (I think it's quite neat and would hope to keep it this way). The issue arises from the DoEvents call (necessary to force a screen repaint for the animation).

The animation is called from certain worksheet change events, and if a second instance of the sub is called (or actually if any event happens it seems), the first one is terminated half complete, and never finishes - meaning the temporary shape is never deleted.

Here's an illustration showing what I'm talking about:

How can I work around this?

Answer 1

It's more of a workout than a solution, but it gets the job done, technically speaking

If you disable the userinput during the runtime of the flashbox procedure it will wait for the animation to finnish and only then re-enable it, you steer clear of the animation staying frozen

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.Interactive = False
    flashBox Target, ColorConstants.vbMagenta
    Application.Interactive = True
End Sub

I'll see if I can solve this "properly" but for now at last this is a nice workaround :)