I have a macro in an excel 2007 worksheet that does timed alerts and works great (one at 30minutes, one at 45 minutes and a third at 90 minutes. The macro is started by a checkbox. However I also need to simultaneously have have a visual timer also once the checkbox is checked. I have created a user form that does this but when I show the form the other timers stop until I cancel or stop the userform. I need them to run concurrently.
Public Sub Escalation_Timer()
Dim StartRed, PauseTimeRed, FinishRed, TotalTimeRed, StartYellow, PauseTimeYellow, FinishYellow, TotalTimeYellow, StartOrange, PauseTimeOrange, FinishOrange, TotalTimeOrange
If Range("E21") = True Then
If (MsgBox("Do you want to Start the Escalation Timer?", 4, "Escalate?")) = vbYes Then
PauseTimeOrange = 1800
StartOrange = Timer
PauseTimeYellow = 2700
StartYellow = Timer
PauseTimeRed = 5400
StartRed = Timer
Do While Timer < StartOrange + PauseTimeOrange
DoEvents
Loop
FinishOrange = Timer
TotalTime = FinishOrange - StartOrange
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Orange Escalation - Initiate Orange Escalation Procedure", _
120, "Orange Alert", vbInformation + 4096
'MsgBox "Orange Escalation - Initiate Orange Escalation Procedure", 0, "Orange Alert"
Else
End
End If
Do While Timer < StartYellow + PauseTimeYellow
DoEvents
Loop
FinishYellow = Timer
TotalTime = FinishYellow - StartYellow
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Yellow Escalation - Initiate Yellow Escalation Procedure", _
120, "Yellow Alert", vbInformation + 4096
'MsgBox "Yellow Escalation - Initiate Yellow Escalation Procedure", 0, "Yellow Alert"
Else
End
End If
Do While Timer < StartRed + PauseTimeRed
DoEvents
Loop
FinishRed = Timer
TotalTimeRed = FinishRed - StartRed
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Red Escalation - Initiate Red Escalation Procedure", _
120, "Red Alert", vbInformation + 4096
'MsgBox "Red Escalation - Initiate Red Escalation Procedure", 0, "Red Alert"
End
End Sub
Public Sub Escalation_Timer()
Dim StartRed, PauseTimeRed, FinishRed, TotalTimeRed, StartYellow, PauseTimeYellow, FinishYellow, TotalTimeYellow, StartOrange, PauseTimeOrange, FinishOrange, TotalTimeOrange
If Range("E21") = True Then
If (MsgBox("Do you want to Start the Escalation Timer?", 4, "Escalate?")) = vbYes Then
PauseTimeOrange = 1800
StartOrange = Timer
PauseTimeYellow = 2700
StartYellow = Timer
PauseTimeRed = 5400
StartRed = Timer
Do While Timer < StartOrange + PauseTimeOrange
DoEvents
Loop
FinishOrange = Timer
TotalTime = FinishOrange - StartOrange
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Orange Escalation - Initiate Orange Escalation Procedure", _
120, "Orange Alert", vbInformation + 4096
'MsgBox "Orange Escalation - Initiate Orange Escalation Procedure", 0, "Orange Alert"
Else
End
End If
Do While Timer < StartYellow + PauseTimeYellow
DoEvents
Loop
FinishYellow = Timer
TotalTime = FinishYellow - StartYellow
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Yellow Escalation - Initiate Yellow Escalation Procedure", _
120, "Yellow Alert", vbInformation + 4096
'MsgBox "Yellow Escalation - Initiate Yellow Escalation Procedure", 0, "Yellow Alert"
Else
End
End If
Do While Timer < StartRed + PauseTimeRed
DoEvents
Loop
FinishRed = Timer
TotalTimeRed = FinishRed - StartRed
Application.Speech.Speak "Time to Escalate!"
Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Red Escalation - Initiate Red Escalation Procedure", _
120, "Red Alert", vbInformation + 4096
'MsgBox "Red Escalation - Initiate Red Escalation Procedure", 0, "Red Alert"
End
End Sub