I am completely lost so any help will be greatly appreciated.
I am attempting to cancel 2 scheduled event that are triggered when the Workbook is opened, and repeated using the Application.Ontime method.
I know that to terminate the OnTime schedule loop, you must provide the exact time that it is scheduled to run and that having multiple Application.OnTime tasks requires multiple variables. This is why I have set two Public variables (Header of the document below Options Explicit):
Dim dTime as Date
Dim dTime2 as Date
The scheduler use these Variables and everything works properly as the code runs every minute.
dTime's value is set inside the TaskTracker function to be:
dTime = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "TaskTracker", , True
dTime2's value is set inside the Autoclear function to be:
dTime2 = Now() + TimeValue("00:01:00")
Application.OnTime dTime, "AutoClear", , True
Despite all this, I get a Method 'ONTIME' of Object'Application' error message when attempting to run the function at the end of the module:
Function AutoDeactivate()
Application.OnTime EarliestTime:=dTime, Procedure:="TaskTracker", _
Schedule:=False
Application.OnTime EarliestTime:=dTime2, Procedure:="AutoClear", _
Schedule:=False
End Function
This is where I absolutely do not get what is going wrong. Triggering the Debug brings me to the OnTime section of each procedure cancel attempt.
Below is the script that contains these elements. Hopefully this will give you guys some insight as to why these event can't be canceled.
Option Explicit
Dim dTime As Date
Dim dTime2 As Date
'------------------------------------------------------------
'This is what checks cells to define if an email notification has to be sent, and what the content of that email should be.
'------------------------------------------------------------
Function TaskTracker()
Dim FormulaCell As Range
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim SendTo As String
Dim CCTo As String
Dim BCCTo As String
Dim MyLimit As Double
Dim MyLimit2 As Double
dTime = Now() + TimeValue("00:01:00")
NotSentMsg = "Not Sent"
SentMsg = "Sent"
SendTo = ThisWorkbook.Worksheets("Tasks").Range("D2")
CCTo = ThisWorkbook.Worksheets("Tasks").Range("E2")
BCCTo = ThisWorkbook.Worksheets("Tasks").Range("F2")
MyLimit = Date
MyLimit2 = ((Round(Now * 1440, 0) - 30) / 1440)
Set FormulaRange = ThisWorkbook.Worksheets("Tasks").Range("F5:F35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If DateValue(CDate(.Value)) = MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
strTO = SendTo
strCC = CCTo
strBCC = BCCTo
strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "B").Value
If Cells(FormulaCell.Row, "C").Value = "" Then
strBody = "Greetings, " & vbNewLine & vbNewLine & _
"Your task : " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date: " & Cells(FormulaCell.Row, "F").Value & "." & vbNewLine & "A wise decision would be to complete this task before it expires!" & _
vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager"
Else
strBody = "Hello, " & vbNewLine & vbNewLine & _
"Your task : " & Cells(FormulaCell.Row, "B").Value & " with the mention: " & Cells(FormulaCell.Row, "C").Value & " is nearing its Due Date: " & Cells(FormulaCell.Row, "F").Value & "." & vbNewLine & "A wise decision would be to complete this task before it expires!" & _
vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager"
End If
If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg
End If
Else
MyMsg = NotSentMsg
End If
If .Value = MyLimit2 Then
MyMsg = NotSentMsg
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell
ExitMacro:
Exit Function
EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." _
& vbLf & Err.Number _
& vbLf & Err.Description
Application.OnTime dTime, "TaskTracker", , True
End Function
'------------------------------------------------------------
'This is the function that clears the rows of Completed Tasks
'------------------------------------------------------------
Function AutoClear()
Dim i As Integer
dTime2 = Now() + TimeValue("00:01:00")
With Tasks
For i = 5 To 35
If .Cells(i, 4).Value Like "Done" And .Cells(i, 5).Value = "1" Then
.Cells(i, 1).ClearContents
.Cells(i, 2).ClearContents
.Cells(i, 3).ClearContents
.Cells(i, 5).ClearContents
.Cells(i, 6).ClearContents
.Cells(i, 4).Value = "Pending"
.Cells(i, 7).Value = "Not Sent"
End If
Next i
End With
Tasks.AutoFilter.ApplyFilter
Application.OnTime dTime2, "AutoClear", , True
End Function
'------------------------------------------------------------
'ThisWorkbook calls this to deactivate the Application.OnTime. This "should" prevent the Excel process from reoppening the worksheets.
'------------------------------------------------------------
Function AutoDeactivate()
On Error Resume Next
Application.OnTime EarliestTime:=dTime, Procedure:="TaskTracker", _
Schedule:=False
Application.OnTime EarliestTime:=dTime2, Procedure:="AutoClear", _
Schedule:=False
End Function