How can I make this userform timer faster?

Question

I have a userform that displays a goal time for workers to shoot for when completing a task. It also has a stopwatch on it that is controlled by a start, stop, and reset button on the userform. If the stopwatch time reaches the goal time and goes over, then there is a box called "extra time" that starts counting up. It just displays how much extra time the employees are taking to complete a task. The code runs insanely slow, and I think it's just because it is continuously runs a do until statement.

Is there anything I could do to make Excel not freeze up as much when I run this?

Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Dim goal As Single
Dim Etime1 As Single
Dim Etime2 As Single
Dim LastEtime2 As Single
Public Sub btnReset_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
Etime1 = 0
Etime2 = 0
LastEtime2 = 0
lblTime.Caption = "00:00:00"
lblExtra.Caption = "00:00:00"
End Sub
Public Sub btnStart_Click()
goal = 86400 * (Sheets("Input").Range("C2")) 'goal time in seconds
StopTimer = False
Etime0 = Timer()
Etime1 = Timer() + goal
Do Until StopTimer
If Etime < goal Then
 Etime = Int((Timer() - Etime0) * 100) / 100
 If Etime > LastEtime Then
 LastEtime = Etime
 lblTime.Caption = Format(Etime / 86400, "hh:mm:ss")
 DoEvents
 End If
Else
 Etime2 = Int((Timer() - Etime1) * 100) / 100
 If Etime2 > LastEtime2 Then
 LastEtime2 = Etime2
 lblExtra.Caption = Format(Etime2 / 86400, "hh:mm:ss")
 DoEvents
 End If
End If
Loop
End Sub
Public Sub btnStop_Click()
StopTimer = True
End Sub
Public Sub ComboBox1_Change()
Dim cotime As Single
'Dim lookup As String
'lookup = Application.WorksheetFunction.c
'cotime = application.WorksheetFunction.IF(ISERROR(VLOOKUP(Combobox1&Combobox2,AvgFor12to14,2,FALSE)),"N/A",VLOOKUP(Combobox1&Combobox2,AvgFor12to14,2,FALSE)/1440))
Sheets("Input").Range("A2") = Me.ComboBox1.Value
'Me.AvgTime.Value = Format(cotime, "hh:mm:ss")
Me.AvgTime.Caption = Format(Sheets("Input").Range("C2"), "hh:mm:ss")
End Sub
Public Sub ComboBox2_Change()
Sheets("Input").Range("B2") = Me.ComboBox2.Value
Me.AvgTime.Caption = Format(Sheets("Input").Range("C2"), "hh:mm:ss")
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.Visible = True
End Sub
Private Sub UserForm_Initialize()
ComboBox2 = ""
ComboBox1 = ""
End Sub

• Mathieu Guindon: Just to be clear, is this code is written in a .bas code module, or it's a sheet's code-behind?
• Neal: This is in the userform module
• RubberDuck: I was looking at this a little closer today, can you explain exactly why you're casting to an int and multiplying... well, why are you doing this? Etime = Int((Timer() - Etime0) * 100) / 100 It doesn't seem to do anything except randomly skew the value by a hundredth of a second or so.

Answer 1

Just formatting first:

Your code is missing indentation and has some extra newlines in it.

Your Do Until loop should be double indented because it is inside of a sub. You should also get rid of the extraneous commented code. If you got it working, get rid of the junk.

Here is what the code should look like:

Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Dim goal As Single
Dim Etime1 As Single
Dim Etime2 As Single
Dim LastEtime2 As Single
Public Sub btnReset_Click()
 StopTimer = True
 Etime = 0
 Etime0 = 0
 LastEtime = 0
 Etime1 = 0
 Etime2 = 0
 LastEtime2 = 0
 lblTime.Caption = "00:00:00"
 lblExtra.Caption = "00:00:00"
End Sub
Public Sub btnStart_Click()
 goal = 86400 * (Sheets("Input").Range("C2")) 'goal time in seconds
 StopTimer = False
 Etime0 = Timer()
 Etime1 = Timer() + goal
 Do Until StopTimer
 If Etime < goal Then
 Etime = Int((Timer() - Etime0) * 100) / 100
 If Etime > LastEtime Then
 LastEtime = Etime
 lblTime.Caption = Format(Etime / 86400, "hh:mm:ss")
 DoEvents
 End If
 Else
 Etime2 = Int((Timer() - Etime1) * 100) / 100
 If Etime2 > LastEtime2 Then
 LastEtime2 = Etime2
 lblExtra.Caption = Format(Etime2 / 86400, "hh:mm:ss")
 DoEvents
 End If
 End If
 Loop
End Sub
Public Sub btnStop_Click()
 StopTimer = True
End Sub
Public Sub ComboBox1_Change()
 Dim cotime As Single
 Sheets("Input").Range("A2") = Me.ComboBox1.Value
 Me.AvgTime.Caption = Format(Sheets("Input").Range("C2"), "hh:mm:ss")
End Sub
Public Sub ComboBox2_Change() 
 Sheets("Input").Range("B2") = Me.ComboBox2.Value
 Me.AvgTime.Caption = Format(Sheets("Input").Range("C2"), "hh:mm:ss")
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 Application.Visible = True
End Sub
Private Sub UserForm_Initialize()
 ComboBox2 = ""
 ComboBox1 = ""
End Sub

It is a lot easier to read this way as well.

---

Your naming should be "pascalCase" for everything.

Lose the Hungarian notation on the labels; name the labels appropriately, like timeOutput or something like that.

• StopTimer -> stopTimer
• Etime -> eTime
• LastEtime -> lastETime

Answer 2

I'm not sure how to make this perform better, but there are a couple of nit-picky things I can share.

• 86400 is a magic number. It would be better to declare a constant with a meaningful name like Private Const SecondsInADay as Int = 86400. It took me a few minutes and a calculator to figure out what it was.

• This block of code is an almost exact duplicate and should become it's own

  If Etime < goal Then
   Etime = Int((Timer() - Etime0) * 100) / 100
   If Etime > LastEtime Then
   LastEtime = Etime
   lblTime.Caption = Format(Etime / 86400, "hh:mm:ss")
   DoEvents
   End If
  Else
   Etime2 = Int((Timer() - Etime1) * 100) / 100
   If Etime2 > LastEtime2 Then
   LastEtime2 = Etime2
   lblExtra.Caption = Format(Etime2 / 86400, "hh:mm:ss")
   DoEvents
   End If
  End If
  

To get started, you could define the two functions below.

Private function getTimeAsInt(ByVal timeAsSingle as Single)
 getTimeAsInt = Int((Timer() - timeAsSingle) * 100) / 100
End Sub
Private Function formatTime(ByVal timeAsSingle as Single)
 formatTime = Format(timeAsSingle / SecondsInADay, "hh:mm:ss")
End Sub

This reduces the duplication a little bit, but not a whole lot.

Do Until StopTimer
 If Etime < goal Then
 Etime = getTimeAsInt(Etime0)
 If Etime > LastEtime Then
 LastEtime = Etime
 lblTime.Caption = formatTime(Etime)
 DoEvents
 End If
 Else
 Etime2 = getTimeAsInt(Etime1)
 If Etime2 > LastEtime2 Then
 LastEtime2 = Etime2
 lblExtra.Caption = formatTime(Etime2)
 DoEvents
 End If
 End If
Loop

• RubberDuck: I suspect an OOP approach might allow you to abstract away all of this duplication though. Unfortunately, I don't have the time right now to figure that all out.