Hello kevinvalerio,
The bug was caused by the ActiveX buttons on the UserForm and Application.OnTime. Clicking and holding a button passed the default time setting causes the Application.OnTime callback to timeout. I created a timer that is independent of Excel.
I have made the needed changes and tested the code many many times for errors. The attached workbook has all the code changes shown added to it.
Module VBA_Timer
Global Paused As Boolean
Global TimerOff As Boolean
'// Conditionally compile the API call for either 64 bit Windows or 32 bit Windows.
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "Kernel32.dll" () As Long
#Else
Private Declare Function GetTickCount Lib "Kernel32.dll" () As Long
#End If
Sub StartTimer(ByRef oleObj As Object)
Paused = False
TimerOff = False
'// Count from 0:00:00 to 8:00:00 hours.
Call vbaUpDownTimer(0, 28799, xlUp, oleObj)
End Sub
Sub StopTimer()
TimerOff = True
End Sub
Sub PauseTimer()
Paused = True
End Sub
Sub ResumeTimer()
Paused = False
End Sub
Sub vbaUpDownTimer(ByVal secsStart As Long, ByVal secsEnd As Long, ByVal Direction As Long, ByRef oleObj As Object)
Dim cnt As Long
Dim Secs As Long
If Direction = xlUp Then Secs = secsStart
If Direction = xlDown Then Secs = secsEnd
Do
oleObj.Caption = Format(Secs / 86400, "h:MM:ss")
'// Pause timer?
While Paused = True: DoEvents: Wend
'// Stop timer?
If TimerOff = True Then Exit Do
cnt = GetTickCount + 1000
'// One second delay.
While GetTickCount <= cnt: Wend
If Direction = xlUp Then
If Secs >= secsEnd Then Exit Do Else Secs = Secs + 1
End If
If Direction = xlDown Then
If Secs <= secsStart Then Exit Do Else Secs = Secs - 1
End If
DoEvents
Loop
End Sub
TimerForm
Option Explicit
Dim s As Integer
Sub SaveTimes()
'Engine holds the values for quantity of current entries on different sheets helps with offsetting
Dim TargetRow As Long
TargetRow = Sheets("Engine").Range("B3").Value
'stores data for finish time
With Sheets("Timer").Range("C5").Offset(TargetRow, 4)
.Value = Now
.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
End With
'code keeps crashing here "Runtime 50290"
'stores data for actual duration of the work order
Sheets("Timer").Range("C5").Offset(TargetRow, 5).Value = "'" & Format(lbl_Timer, "hh:mm:ss")
'moves selection to the row where the next order will be placed
Sheets("Timer").Range("C5").Offset(TargetRow + 1, 0).Select
'timestamp for finish order
With Sheets("Timer").Range("C5").Offset(TargetRow - 1, 3)
.Value = Now
.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
End With
' Runtime 50290 error crashes here
'there is a timer on this userform and a=false stops the timer before the userform is closed
'timer = False
TimerOff = True
Unload TimerForm
'if timer value is greater than planned time with 15% buffer then operator will have to input reason for downtime
End Sub
Private Sub UserForm_Activate()
'makes userform pop up in a specific location each time
Me.StartUpPosition = 0
Me.Top = Application.Top + 25
Me.Left = Application.Left + Application.Width - Me.Width - 25
'sets variables so that excel can find the exact rows to put the data in
Dim TargetRow As Long
TargetRow = Sheets("Engine").Range("B3").Value + 1
Dim TargetRow2 As Long
TargetRow2 = Sheets("Engine").Range("I3").Value + 1
'automatically populates information for material, quality in the userform
txt_Material1.Value = Sheets("Timer").Range("C5").Offset(TargetRow - 1, 0).Value
txt_Quantity1.Value = Sheets("Timer").Range("C5").Offset(TargetRow - 1, 1).Value
'starts off the timer at 0:00:00 and stops at 8:00:00.
Call StartTimer(Me.lbl_Timer)
End Sub
Private Sub cmd_Pause_Click()
Paused = True
End Sub
Private Sub cmd_Resume_Click()
Paused = False
End Sub
Private Sub cmd_Finish_Click()
Call SaveTimes
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call SaveTimes
End Sub
Merry Christmas and Happy New Year!
Nollaig Chridheil agus Bliadhna Mhath Ùr!
Reply With Quote
