Application.Ontime

ccordner

Active Member
Joined
Apr 28, 2010
Messages
347
Hi

I have a routine which is set to execute at a set time (contained in a cell in the workbook). It works perfectly, unless there is another workbook open.

If I open the file with another workbook open, everything freezes, but only if the one with "Application.OnTime" in it is opened second.

Any ideas why this might be?

Chris
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Chris, Could you post your code that uses Application.OnTime?

Also do you have Event code running in either of the two workbooks (like Workbook_Open)?
 

ccordner

Active Member
Joined
Apr 28, 2010
Messages
347
Certainly.

Yes, I do have code in the Workbook_Open module, as shown below:

Code:
Dim Count As Long
Dim Found As Boolean
Dim TempArray() As Variant
Private Sub Workbook_Open()
ArrayCount = 0
Limit = 1
Found = False
ReDim TimeEvents(3, 0)
While Found = False
    If Sheets("Stations").Cells(Limit + 1, 1) = "" Then Found = True Else Limit = Limit + 1
Wend
Found = False
While Found = False
    GracePeriod = InputBox("Please enter your preferred grace period in minutes", "Select Grace Period", 10)
    If IsNumeric(GracePeriod) Then
        GracePeriod = Int(GracePeriod)
        If GracePeriod < 31 Then Found = True
    End If
    
    If Found = False Then MsgBox ("The grace period you have chosen is invalid. The maximum allowable grace period is thirty minutes.")
Wend
For Count = 1 To Limit - 1
    ReDim Preserve TimeEvents(3, (2 * Count) - 1)
    
    With Sheets("Stations")
    
        TimeEvents(0, (2 * Count) - 2) = .Cells(Count + 1, 1)
        TimeEvents(1, (2 * Count) - 2) = .Cells(Count + 1, 4)
        TimeEvents(2, (2 * Count) - 2) = .Cells(Count + 1, 2) + TimeSerial(0, GracePeriod, 0)
        TimeEvents(3, (2 * Count) - 2) = "Open"
    
        TimeEvents(0, (2 * Count) - 1) = .Cells(Count + 1, 1)
        TimeEvents(1, (2 * Count) - 1) = .Cells(Count + 1, 4)
        TimeEvents(2, (2 * Count) - 1) = .Cells(Count + 1, 3) + TimeSerial(0, GracePeriod, 0)
        TimeEvents(3, (2 * Count) - 1) = "Close"
    
    End With
Next
' Bubble Sort Time Events
ReDim TempArray(3, 1)
Limit = UBound(TimeEvents, 2)
For i = 0 To Limit
    For j = i + 1 To Limit
        If TimeEvents(2, i) > TimeEvents(2, j) Then
            For k = 0 To 3
                TempArray(k, 0) = TimeEvents(k, i)
                TimeEvents(k, i) = TimeEvents(k, j)
                TimeEvents(k, j) = TempArray(k, 0)
            Next
        End If
    Next j
Next
Found = False
Limit = 2
While Found = False
    If Sheets("Events").Cells(Limit + 1, 1) = "" Then Found = True Else Limit = Limit + 1
Wend
If TimeEvents(2, ArrayCount) <= TimeValue(Now) Then Application.OnTime Now + TimeValue("00:00:01"), "Reminder" Else Application.OnTime TimeEvents(2, ArrayCount), "Reminder"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
'Application.OnTime dtime, "RemindMe", , False
Me.Save
End Sub

I also have, in a normal module, this code:

Code:
Sub Reminder()
' Check for event
For Count = 2 To Limit
    If Sheets("Events").Cells(Count, 3) = TimeEvents(0, ArrayCount) And Sheets("Events").Cells(Count, 4) = DateValue(Now) And Sheets("Events").Cells(Count, 7) = TimeEvents(3, ArrayCount) Then
        Exit For
        
    Else
        
        If Count = Limit Then
        
            Limit = Limit + 1
        
            Load frmReminder
            Station = TimeEvents(0, ArrayCount)
            TimeDue = Format(TimeEvents(2, ArrayCount) - TimeSerial(0, GracePeriod, 0), "h:mm")
            If TimeEvents(3, ArrayCount) = "Open" Then CallType = "sign on" Else CallType = "sign off"
            
            With frmReminder
                
                .lblFailedToCall.Caption = Station & " station failed to " & CallType & " at " & TimeDue & " today."
                .lblChased.Caption = .lblChased.Caption & TimeEvents(1, ArrayCount) & "."
                .lblStation.Caption = Station & " station."
                .lblTimeDue = "Time Due: " & Format(TimeEvents(2, ArrayCount) - TimeSerial(0, GracePeriod, 0), "h:mm")
                .Show
                
                If .Tag = "Snoozed" Then
                
                    Snoozed = True
                
                Else
                                
                    Sheets("Events").Cells(Limit, 1) = Limit - 1
                    Sheets("Events").Cells(Limit, 2) = Now
                    Sheets("Events").Cells(Limit, 3) = Station
                    Sheets("Events").Cells(Limit, 4) = DateValue(Now)
                    Sheets("Events").Cells(Limit, 5) = Format(TimeValue(Now), "hh:mm")
                    Sheets("Events").Cells(Limit, 6) = .cboEmployee.Value
                    Sheets("Events").Cells(Limit, 7) = TimeEvents(3, ArrayCount)
                    Sheets("Events").Cells(Limit, 8) = .cboSupervisor.Value
                    If .optForgot.Value = "True" Then
                        Sheets("Events").Cells(Limit, 9) = "Spontaneous"
                    ElseIf .optChased.Value = "True" Then
                        Sheets("Events").Cells(Limit, 9) = "Solicited"
                    ElseIf .optControl.Value = "True" Then
                        Sheets("Events").Cells(Limit, 9) = "AWOL"
                    End If
                    If .optControl.Value = "True" Then Sheets("Events").Cells(Limit, 10) = "Control Ref.: " & .txtLogNo.Value & Chr(10) & .txtComments.Value Else Sheets("Events").Cells(Limit, 10) = .txtComments.Value
                
                End If
                
            End With
            
            Unload frmReminder
            
        End If
        
    End If
Next
If Snoozed = True Then
    dtime = TimeValue(Now) + TimeSerial(0, 10, 0)
    Snoozed = False
Else
    ArrayCount = ArrayCount + 1
    
    If ArrayCount <= UBound(TimeEvents, 2) Then
    
        dtime = TimeEvents(2, ArrayCount)
    
    End If
End If
If ArrayCount <= UBound(TimeEvents, 2) Then
    If dtime > TimeValue(Now) Then Application.OnTime dtime, "Reminder" Else Application.OnTime Now + TimeValue("00:00:01"), "Reminder"
End If
End Sub
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
The part that is probably causing things to freeze up when you have more than one workbook open is that your Reminder macro is referencing the workbook that has sheets "Stations" and "Events" and its Userform; but you are not fully qualifying those references with the name of the workbook.

The problem is that if your workbook with the Reminder macro code is not the ActiveWorkbook at the time the that Application.OnTime event is triggered, those objects won't be found.

There are several problems with code you posted, so I'm not sure if your adding those references will solve the problem, but it's a necessary first step.

The code would be much better if you:
1. Use Optiion Explicit, declare all your variables and run the compiler in the VBE after making changes to your code.
2. Eliminate the use of Public variables declared outside of Procedures.

If you have a go at making those changes, I'll be glad to help if I can.
 
Last edited:

ccordner

Active Member
Joined
Apr 28, 2010
Messages
347
Thanks for this.

The only reason I used public variables was to hold values and arrays in memory, rather than having to write them to random cells on a worksheet, which just seems a bit messy and amateurish to me (also prone to somebody deleting them accidentally). Is there another way around this?

Does Option Explicit need to be declared in each module? Including the Workbook_Open module?
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
The only reason I used public variables was to hold values and arrays in memory, rather than having to write them to random cells on a worksheet, which just seems a bit messy and amateurish to me (also prone to somebody deleting them accidentally). Is there another way around this?
I think what you are doing can be done without the need do save values and arrays in memory or in elsewhere. Rather than gathering and saving that information during the Workbook_Open event, you could read those values when the Sub Reminder is triggered.

Typically the use of Public variables should be avoided if alternatives available. You have the added risk of having all those variables reset if your application has an unhandled error. Normally that risk is secondary to control issues, but in your process those variables might need to be in memory for several hours until the OnTime procedure is triggered.

Does Option Explicit need to be declared in each module? Including the Workbook_Open module?

Option Explicit isn't required, but it's a best practice to use it to ensure that variables are correctly typed. It also helps catch some errors prior to runtime.
So using it in all modules including the ThisWorkbook module is a good idea.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,592
Messages
5,625,684
Members
416,127
Latest member
MALEPINZON

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top