macro to pause code, another to resume

[DerekF]

hello All,

I have a workbook with several hundred row the VBA code loops through. It takes about an hour to run all the calculations. Whenever I need to pause the script I hit ESC, which works well for me, but for other users it would be nice to have a command button that halts code. Even better would be another button to resume code.

Any ideas where a guy could start looking into this?

Derek

 

[Legacy 98055]

Sure. See the DoEvents statement in VBA help. In essence, one or more
DoEvents statements shoud be fine in this procedure. DoEvents will slow down your code, so use it only where needed. You might have to experiment a bit to figure out where that is...

This is too many, but it will definitely give you a good repsonse time on your Pause button. Remove some or all but one of these...

<table width="100%" border="1" bgcolor="White" style="filterrogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Dim</font> c <font color="#0000A0">As</font> <font color="#0000A0">Variant</font>
  <font color="#0000A0">Dim</font> NextRow <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Dim</font> DomainName, ComputerName, UserName
  <font color="#0000A0">Dim</font> Paused <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_Open()
       StartDataRun
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> StartDataRun()
       DataRun
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> PauseDataRun()
       Paused = <font color="#0000A0">True</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> ResumeDataRun()
       DataRun <font color="#0000A0">True</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> DataRun(Optional OnResume <font color="#0000A0">As</font> Boolean)

       Paused = <font color="#0000A0">False</font>

       <font color="#0000A0">If</font> <font color="#0000A0">Not</font> OnResume <font color="#0000A0">Then</font>
           c = <font color="#0000A0">Empty</font>
           NextRow = 2
           DomainName = Environ("UserDomain")
           ComputerName = Environ("ComputerName")
           UserName = Environ("UserName")
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">GoTo</font> Errlog
       <font color="#0000A0">With</font> Worksheets("ADMIN")
         <font color="#0000A0">If</font> IsEmpty(.Cells(NextRow, "A")) <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
         <font color="#0000A0">While</font> <font color="#0000A0">Not</font> IsEmpty(.Cells(NextRow, "A")) <font color="#0000A0">And</font> NextRow < 200
           DoEvents
           Worksheets("QC").Range("E35").Value = .Cells(NextRow, "A").Value
           Worksheets("QC").Range("E1:E41").Calculate
           Sheet6.DR: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet10.GC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet11.SRC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet2.SC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet7.TBS: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Range("E1:E40").Calculate: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet9.HQC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet12.ORC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Sheet1.Get_telemetry: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Application.Calculate: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet1.Filltable: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           Module1.Qnamesdelete: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> Sub: DoEvents
           NextRow = NextRow + 1
         <font color="#0000A0">Wend</font>
       <font color="#0000A0">End</font> <font color="#0000A0">With</font>


  Errlog:
       <font color="#0000A0">Dim</font> ff <font color="#0000A0">As</font> <font color="#0000A0">Integer</font>
       ff = FreeFile
       <font color="#0000A0">Open</font> ThisWorkbook.Path & "\logfile.txt" <font color="#0000A0">For</font> <font color="#0000A0">Append</font> <font color="#0000A0">As</font> #ff
       <font color="#0000A0">Print</font> #ff, " " & Worksheets("QC").Range("E35").Value & " <font color="#0000A0">Error</font> " & Err.Number & " (" & Err.Description & "), " & Now
       <font color="#0000A0">Close</font> #ff


       <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>
       Application.DisplayAlerts = <font color="#0000A0">False</font>
       ActiveWorkbook.Save
       Application.Quit
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("11212007174232416").value=document.all("11212007174232416").value.replace(/<br \/>\s\s/g,"");document.all("11212007174232416").value=document.all("11212007174232416").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("11212007174232416").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="11212007174232416" wrap="virtual">
Option Explicit

Dim c As Variant
Dim NextRow As Long
Dim DomainName, ComputerName, UserName
Dim Paused As Boolean

Private Sub Workbook_Open()
StartDataRun
End Sub

Sub StartDataRun()
DataRun
End Sub

Sub PauseDataRun()
Paused = True
End Sub

Sub ResumeDataRun()
DataRun True
End Sub

Sub DataRun(Optional OnResume As Boolean)

Paused = False

If Not OnResume Then
c = Empty
NextRow = 2
DomainName = Environ("UserDomain")
ComputerName = Environ("ComputerName")
UserName = Environ("UserName")
End If

On Error GoTo Errlog
With Worksheets("ADMIN")
If IsEmpty(.Cells(NextRow, "A")) Then Exit Sub
While Not IsEmpty(.Cells(NextRow, "A")) And NextRow < 200
DoEvents
Worksheets("QC").Range("E35").Value = .Cells(NextRow, "A").Value
Worksheets("QC").Range("E1:E41").Calculate
Sheet6.DR: If Paused Then Exit Sub: DoEvents
Sheet10.GC: If Paused Then Exit Sub: DoEvents
Sheet11.SRC: If Paused Then Exit Sub: DoEvents
Sheet2.SC: If Paused Then Exit Sub: DoEvents
Sheet7.TBS: If Paused Then Exit Sub: DoEvents
Range("E1:E40").Calculate: If Paused Then Exit Sub
Sheet9.HQC: If Paused Then Exit Sub: DoEvents
Sheet12.ORC: If Paused Then Exit Sub: DoEvents
Sheet1.Get_telemetry: If Paused Then Exit Sub: DoEvents
Application.Calculate: If Paused Then Exit Sub
Sheet1.Filltable: If Paused Then Exit Sub: DoEvents
Module1.Qnamesdelete: If Paused Then Exit Sub: DoEvents
NextRow = NextRow + 1
Wend
End With


Errlog:
Dim ff As Integer
ff = FreeFile
Open ThisWorkbook.Path & "\logfile.txt" For Append As #ff
Print #ff, " " & Worksheets("QC").Range("E35").Value & " Error " & Err.Number & " (" & Err.Description & "), " & Now
Close #ff


Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub</textarea>

 

[DerekF]

If I try to stop the script using the PauseDataRun() macro it does seem to stop and exit the sub.

I looked into it and it seems to be always defaulting back to paused = false even if I take the "Paused = false" line out of the code. Why would it default to false? If I set the "Paused = false" to "Paused = true" then it works, but of course, it would prevent the script from running in reality.

ANy ideas.........

 

[Legacy 98055]

I don't know? Have you declared the variable 'Paused' in the general declarations section where it should maintain state? Set a watch for this variable with break on change to determine when the value is changing. Please post your code as is... Thanks.

 

[DerekF]

Thanks for the idea. I have been working with VBA for a few months now on and off but its self taught and I wish I would have known about the watch window functions earlier!!

I had changed the script a bit and the pause variable was set in the Datarun Sub and I changed it to the top of the module and Voila!

Thanks again right_click!!!!