snippetMinor
How can I make this userform timer faster?
Viewed 0 times
thiscanuserformmakefastertimerhow
Problem
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 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
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 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
Solution
Just formatting first:
Your code is missing indentation and has some extra newlines in it.
Your
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:
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
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 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 SubIt 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
Code Snippets
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 SubContext
StackExchange Code Review Q#57573, answer score: 8
Revisions (0)
No revisions yet.