Search code examples
excelvbaloopstimer

Why does VBA in Excel slow down if a timer is used for controlled time lags?


I am currently messing around with VBA in Excel and thought it would be interesting to build an own Version of Tetris. Of course I don't start with all parts from the get go.

Here's the set up I have started this little work: Within a 3x3 field in the first thre rows and columns is a field to let the squares slowly fall from top to bottom. To keep things simple, the only item is a single square; moving left or right would be the next step for me.

Anyway: I managed to write VBA code where squares keep appearing and falling until a new square would hit an already filled cell within the top of the 3x3 field. So far so good.

When the code is activated everything happens in a fraction of a second, but works.

If one uses F5 to go through the steps, it works as well.

Naturally, Tetris needs to have sort of a delayed movement for the squares for any player to catch up visually with whats happening. Hence I have built in a timer to "block" the progression of my code for half a second. That is where I am not sure, if everything works as it should.

Upon starting the code, it works, BUT the cursor isn't operable and I can hear my laptop working harder. In my code below you can see the three rows deactivated for the moment by turning them into comments.

Why does this happen? Should I throw in some sort of "dummy tasks" the timed loop should execute to make it do something (I know, that doesn't sound to reasonable). Can it be, that by leaving it empty, the code rushes through like crazy?

I'd appreciate any recommendations.

Sub tetris()

Dim a As Byte, b As Byte, start As Double
Range(Cells(1, 1), Cells(10, 10)).ClearFormats
beginning:
a = Rnd() * 3 + 0.5
If Cells(1, a).Interior.Color = vbRed Then
    GoTo gameover
    Else
    Cells(1, a).Interior.Color = vbRed
End If
b = 1
Do While b < 3
'    start = Timer
'    Do While Timer <= start + 0.5
'    Loop
    If Cells(1 + b, a).Interior.Color = vbRed Then
        GoTo beginning
        Else
        Cells(b, a).Interior.Color = xlNone
        Cells(1 + b, a).Interior.Color = vbRed
    End If
    b = b + 1
Loop

GoTo beginning
gameover:
MsgBox "Game Over"
End Sub

Solution

  • You can use an api to wait in VBA. The code below gives you a simple one, it is not my code, source given:

    Public Sub WaitSeconds(intSeconds As Integer)
      ' Comments: Waits for a specified number of seconds
      ' Params  : intSeconds      Number of seconds to wait
      ' Source  : Total Visual SourceBook
      ' Source  : http://www.fmsinc.com/microsoftaccess/modules/examples/avoiddoevents.asp
    Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
      On Error GoTo PROC_ERR
    
      Dim datTime As Date
    
      datTime = DateAdd("s", intSeconds, Now)
    
      Do
       ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
        Sleep 100
        DoEvents
      Loop Until Now >= datTime
    
    PROC_EXIT:
      Exit Sub
    
    PROC_ERR:
      MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitSeconds"
      Resume PROC_EXIT
    End Sub
    

    In order to continue to be able to use Excel while the timer is going, you would need to als set DoEvents in the code.