How do I pause a running program in VBA

In an Excel worksheet, say I have a column called program counter and another column has the function that it should call. I have created a userform as illustrated in the image. Enter the program counter which you want your program to run up to. For example, if you enter program counter as 20 and click Run, the program runs from 1 till 20. However, if it was in the middle of running and you click on 'Pause', the program should stop running. How can I do this? How do I resume upon pressing t he resume button? Any help would be  much appreciated. Thanks.
userform.JPG
teelingAsked:
Who is Participating?
 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
Here's a very basic version of what you need. Have a form with three command buttons cmdStart, cmdPause and cmdResume, a textbox textbox1 and a label label1.
I have commented all the lines of the code so hopefully you can see what is going on:
The label is there so you can see your counter (and I'm using it to preserve the ctr value when paused).
It needs a check that the textbox actually holds a legal value before you start, I'd put this under the start button and only call the increment routine if the value is a good one.
On testing it, if you are just going to let it run you will need to use a value something like 20000 or you won't be able to pause fast enough.
 

Option Explicit
 Dim runstatus As Boolean 'whether the loop can run or not. form level so all the procedures can see it
Private Sub cmdPause_Click()
    runstatus = False 'set the status so the loop will stop
End Sub
Private Sub cmdResume_Click()
    increment CLng(Label1.Caption) 'restart the counting using the preserved value of the counter
End Sub
Private Sub cmdStart_Click()
    increment 1 'start the counting from 1
End Sub
Private Sub increment(ctr As Long)
 runstatus = True 'make sure the loop can run
 Do While runstatus = True And ctr < Val(TextBox1.Value) 'only enter this loop if runstatus is true and the ctr hasn't finished
    ctr = ctr + 1 'increment the counter
    Label1.Caption = ctr 'output the counter value, using the label caption as a store of the current value
    DoEvents 'so the label can update its caption, and to allow the pause button to be pressed
 Loop 're-enter the loop if the loop conditions are still true
End Sub

 
I'm sorry I took so long to get back to you, but if you need any more explanation please ask.
0
 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
Put a call to DoEvents in your loop
 
for f = 1 to 20
DoEvents
increase counter
Next
0
 
teelingAuthor Commented:
I have done that. What I need to know is the pausing part.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
I missed a bit, the DoEvents will allow Windows to detect that you have pressed the pause button., Otherwise the lop will need to complete before the button code will be called.
There are a number of ways to have the buttons work. A simple way is to have a boolean variable called Run. Set this to true when you pres the start button and check it inside the loop. If the pause button is pressed then set that variable to false. Continue sets it back true again.
 

for f = 1 to 20
DoEvents
if Run=True then
increase counter
end if
Next
0
 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
Actually that's nasty, I apologise.
Better with a While loop
 
Do While Run = True
Do Events
increase counter
Loop
 
 
Sub Pause
Run = False
End Sub
 
Sub Continue
Run = True
End Sub
0
 
teelingAuthor Commented:
Can't seem to get it to pause. Can you check my codes? Thanks.
Private Sub cmdLogin_Click()
    RunStatus = True
    
    Do While RunStatus = True
    DoEvents

        progctrfinal = TextBox1.Value
        For progctr = 1 To progctrfinal Step 1
            Call optionStatus(progctr)
            If progstuck Then Exit Sub
        Next progctr

    Loop
End Sub

Private Sub Pause_Click()
    RunStatus = False
End Sub

Private Sub Resume_Click()
    RunStatus = True
End Sub

Open in new window

0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
To "pause" you have to store the LAST processed value for "progctr" in another variable (outside the subs or make it static) and then START the loop back up from the next value in the loop so it appears to "resume" from where it left off.

    For progctr = lastValue To progctrfinal Step 1
0
 
teelingAuthor Commented:
Can you perhaps show me by inserting them in the codes? Thanks.
0
 
teelingAuthor Commented:
Can you perhaps show me by inserting them in the codes? Thanks.
0
 
Dymer2Commented:
Hi,
I think Idle Mind means this:



Private Sub cmdLogin_Click()
    static progctrfinal as integer
    RunStatus = True
   
    Do While RunStatus = True
    DoEvents

        progctrfinal = TextBox1.Value
        For progctr = 1 To progctrfinal Step 1
            Call optionStatus(progctr)
            If progstuck Then Exit Sub
        Next progctr

    Loop
End Sub

Private Sub Pause_Click()
    RunStatus = False
End Sub

Private Sub Resume_Click()
    RunStatus = True
End Sub
0
 
teelingAuthor Commented:
I have tried the code below but it doesn't seem to pause. Anyone's got any idea why?
Private Sub cmdLogin_Click()
    RunStatus = True
    If OptionButton2.Value Then
        Debug.Print "Stop"
        Exit Sub
    End If
    
    If Restart.Value Then Call optionStatus(1)
    
    If pauseflag = 0 Then
     Do While RunStatus = True
        progctrfinal = TextBox1.Value
        For progctr = 1 To progctrfinal Step 1
            DoEvents
            Call optionStatus(progctr)
            If progstuck Then Exit Sub
        Next progctr
     Loop
    End If
    
    If pauseflag = 1 Then
        pauseflag = 0
        Do While RunStatus = True
            progctrfinal = TextBox1.Value
            For progctr = lastprogctr + 1 To progctrfinal Step 1
                DoEvents
                Call optionStatus(progctr)
                If progstuck Then Exit Sub
            Next progctr
        Loop
    End If
    
End Sub

Private Sub CommandButton1_Click()  'Pause
    lastprogctr = progctr
    pauseflag = 1
    RunStatus = False
End Sub

Private Sub CommandButton2_Click()  'Resume
    RunStatus = True
End Sub

Open in new window

0
 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
sorry, I needed to go to bed.
in your code you are checking the pauseflag before you enter your increment loops, but you need to check it inside the loops, at an appropriate place.
try adding:
if pauseflag=1 stopvalue then exit do

add this after where  you start the loop counter and before the end of the loop.

as your program loops it must check the counter to see if it has reached the end condition, increment the counter AND check  to see if any other exit condition has occurred.
0
 
Thibault St john Cholmondeley-ffeatherstonehaugh the 2ndCommented:
sry again, cantsee your code while im typing on my mobile.
you need to check the exit condition inside your For loops.
try not using For Next and just use do while
its only one extra step to increment your counter

do while ctr<20 And pauseflag=0
increment ctr
doevents
loop
0
 
teelingAuthor Commented:
The line below causes an error. Run-time error '13': Type mismatch. Why is that so?
increment CLng(Label1.Caption) 'restart the counting using the preserved value of the counter

Open in new window

0
 
teelingAuthor Commented:
My mistake. My label should be label3 instead of label1. I've got it working. Thanks a lot RobinD.
0
 
teelingAuthor Commented:
Fantastic solution.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.