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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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

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.
dlmilleCommented:
Then, why did you close the question out?  Do you need a progress bar (I must have missed that part)?

Dave
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

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
dlmilleCommented:
I have the countdown for you now.  Do you want it?

Dave
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.
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
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
dlmilleCommented:
Please let me know when you get a chance if this is working well for you.

Cheers,

Dave
clemexAuthor Commented:
This is exactly what I needed!

Thank you Dave,
Myriam
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
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.