vba - Excel - userform - countdown delay OR OK/Cancel

Hi experts,

I'd like to show a message at the beginning of a macro that will allow the user to Abort (or continue) immediately.
However, if the user is not there, I want the execution to continue after let's say 15 seconds. Of course, I would like this message to show a countdown for the user to know how many seconds are remaining for a potential abort before its too late.

Any suggestion?
Thanks in advance!
clemexAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
I believe I've already developed what you need in a past solution.  The userform goes up and the user has a chance to cancel, but after so many seconds, the process continues the automation.

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_27454496.html

Let me know if I can be of further assistance.

Cheers,

Dave
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
clemexAuthor Commented:
Would be excellent with a countdown or a progress bar indicating the time remaining to cancel.
0
dlmilleCommented:
Then, why did you close the question out?  Do you need a progress bar (I must have missed that part)?

Dave
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

clemexAuthor Commented:
Sorry, but I wrote: "... I would like this message to show a countdown for the user to know how many seconds are remaining for a potential abort before its too late." Your solution was perfect for the first part but this part was missing. As I needed to deliver the macro right away, I did a rapid search elsewhere and found something to replace the countdown, a progress bar which is not as good but does the job.
Myriam
0
dlmilleCommented:
I have the countdown for you now.  Do you want it?

Dave
0
clemexAuthor Commented:
Of course! I would use it next time I will have to make changes to this macro or in another macro, it can always be useful. Is there a way I can change the Good to Excellent? Next time, I will wait a bit before closing a question.
0
dlmilleCommented:
No worries, I appreciate you wanting exactly what you asked for (and barring a reason to provide that, I would recommend probing the Expert as he - at least I - may not have caught 100% of what you needed).

You can request attention and then regrade as you choose.

Give me a moment, I'm testing and prettying it up a bit....

;)

Dave
0
dlmilleCommented:
Ok - thanks for your patience.

You have the option to set Hours, Mins, and Seconds on the wait (I added a bit more sophistication to give you a better app).  There are two timers running - one to "continueAutomation" and one to update the progress in the form of a countdown clock.

Here's the code in a public module:
Option Explicit

Public timeDisplay As Date
Public timeStarted As Date
Public timeContinueAutomation As Date
Public bAbort As Boolean
Public bContinue As Boolean
Public runWhen As Double

Public Sub getItGoing()
Dim waitHours As Integer
Dim waitMins As Integer
Dim waitSecs As Integer

    bAbort = False
    bContinue = False
    
    waitHours = 0
    waitMins = 1
    waitSecs = 10

    timeDisplay = TimeSerial(waitHours, waitMins, waitSecs)
    UserForm1.lblCountDown = Format(timeDisplay, "HH:MM:SS")
    
    timeStarted = Now()
    timeContinueAutomation = Now() + TimeSerial(waitHours, waitMins, waitSecs) 'How much time until the process continues the automation
    
    Application.OnTime earliesttime:=timeContinueAutomation, procedure:="continueAutomation", schedule:=True
    Application.OnTime earliesttime:=Now() + TimeSerial(0, 0, 1), procedure:="updateCountDownLabel", schedule:=True
    
    Load UserForm1
    UserForm1.Show
End Sub
Sub updateCountDownLabel()
Dim cntDown As String

    If Not bAbort And Not bContinue Then
        'timeDisplay = timeDisplay - TimeSerial(0, 0, 1)
        timeDisplay = timeContinueAutomation - Now()
        UserForm1.lblCountDown = Format(timeDisplay, "HH:MM:SS")
        runWhen = Now() + TimeSerial(0, 0, 1)
        'Debug.Print "scheduling " & runWhen
        Application.OnTime earliesttime:=runWhen, procedure:="updateCountDownLabel", schedule:=True
    Else
        Call stopTimerUpdateCountDownLabel
    End If
End Sub
Sub stopTimerUpdateCountDownLabel()
        On Error Resume Next
        'Debug.Print "cancelling " & runWhen
        Application.OnTime earliesttime:=runWhen, procedure:="updateCountDownLabel", schedule:=False
        On Error GoTo 0
End Sub
Public Sub continueAutomation()
    Unload UserForm1
    If Not bAbort And Not bContinue Then
        Call macroToRun
    End If
End Sub

Sub macroToRun()
    bContinue = True
    MsgBox "You're now running the automated open code...", vbOKOnly, "not really - just a prompt for example" '<- replace this with your code that runs after 5 seconds, or a call to that subroutine
End Sub

Open in new window


And here's the userform code:
Option Explicit

Private Sub cbCancel_Click()
    bAbort = True
    Unload UserForm1
End Sub

Private Sub cbContinue_Click()
    Unload UserForm1
    Call macroToRun
End Sub

Open in new window


See attached demonstration workbook.

Cheers,

Dave
countDownTimer-r2.xls
0
dlmilleCommented:
Please let me know when you get a chance if this is working well for you.

Cheers,

Dave
0
clemexAuthor Commented:
This is exactly what I needed!

Thank you Dave,
Myriam
0
dlmilleCommented:
Glad you liked it.  If you want to award/recognize my final post, you can request attention and the moderator will assist from there.

Dave
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.