macro to pause code, another to resume

DerekF

Board Regular
Joined
May 28, 2006
Messages
138
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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,357
Office Version
  1. 365
Platform
  1. Windows
Derek

What sort of calculations/operations are you doing?

It seems, to me at least, that the code taking several hours to run is rather excessive.:eek:
 

DerekF

Board Regular
Joined
May 28, 2006
Messages
138
The reason it takes so long has more to do with the network speed than anything. My workbook queries 10 ODBC tables, then runs a series of calculations on the results. Then it pushes the updated results to another database. The calculations part actually only takes a few seconds but the queries and pust take the bulk of the work. The queries in total take about 20 seconds, teh calculations take about 2 and the push takes about 20. This process loops through a list and there are about 200 items in the list. Thus the large amount of time.

What I want to be able to do is stop and start the process, which I can do crudely through hitting the esc button. But if there was a way I could do this with a command button that would be great.
 
L

Legacy 98055

Guest
Derek. The answer I could give you would depend greatly upon how your code is structured. Please post it. There are a variety of ways to pause and resume code.
 

DerekF

Board Regular
Joined
May 28, 2006
Messages
138
Here is my code. As you can see, it loops thru all the macros that query different databases. I would like to have the ability to stop and restart the code. Any help would be greatly appreciated!
Code:
Private Sub Workbook_Open()
Dim c As Variant
Dim NextRow As Long
Dim DomainName, ComputerName, UserName

DomainName = Environ("UserDomain")
ComputerName = Environ("ComputerName")
UserName = Environ("UserName")

 
On Error GoTo Errlog
NextRow = 2
With Worksheets("ADMIN")
  If IsEmpty(.Cells(NextRow, "A")) Then Exit Sub
  While Not IsEmpty(.Cells(NextRow, "A")) And NextRow < 200
    Worksheets("QC").Range("E35").Value = .Cells(NextRow, "A").Value
    Worksheets("QC").Range("E1:E41").Calculate
    Sheet6.DR
    Sheet10.GC
    Sheet11.SRC
    Sheet2.SC
    Sheet7.TBS
    Range("E1:E40").Calculate
    Sheet9.HQC
    Sheet12.ORC
    Sheet1.Get_telemetry
    Application.Calculate
    Sheet1.Filltable
    Module1.Qnamesdelete
    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
 
L

Legacy 98055

Guest
Derek. I cannot possilby know the strategic locations to pause. You will have to edit to suit. Just assign the logically named macros to your buttons or create several controls on a custom commandbar.

<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <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
           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> <font color="#0000A0">Sub</font>
           Sheet10.GC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet11.SRC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet2.SC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet7.TBS: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           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> <font color="#0000A0">Sub</font>
           Sheet12.ORC: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           Sheet1.Get_telemetry: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           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> <font color="#0000A0">Sub</font>
           Module1.Qnamesdelete: <font color="#0000A0">If</font> Paused <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           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("112200714751166").value=document.all("112200714751166").value.replace(/<br \/>\s\s/g,"");document.all("112200714751166").value=document.all("112200714751166").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("112200714751166").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="112200714751166" wrap="virtual">
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
Worksheets("QC").Range("E35").Value = .Cells(NextRow, "A").Value
Worksheets("QC").Range("E1:E41").Calculate
Sheet6.DR: If Paused Then Exit Sub
Sheet10.GC: If Paused Then Exit Sub
Sheet11.SRC: If Paused Then Exit Sub
Sheet2.SC: If Paused Then Exit Sub
Sheet7.TBS: If Paused Then Exit Sub
Range("E1:E40").Calculate: If Paused Then Exit Sub
Sheet9.HQC: If Paused Then Exit Sub
Sheet12.ORC: If Paused Then Exit Sub
Sheet1.Get_telemetry: If Paused Then Exit Sub
Application.Calculate: If Paused Then Exit Sub
Sheet1.Filltable: If Paused Then Exit Sub
Module1.Qnamesdelete: If Paused Then Exit Sub
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

Board Regular
Joined
May 28, 2006
Messages
138
Thanks a million!

I have incorportated this into my workbook and it restarts the process perfectly, however, the command button that run Sub PauseDataRun() does not seem to pause the running script. I assume this is because the code is running and running without breaks for an extended period of time and when I hit the pause button, the process is too busy to even recognize the button is pushed. Any ideas what can be put in the code to allow this pause button to register?
 

Forum statistics

Threads
1,181,102
Messages
5,928,062
Members
436,586
Latest member
latintxn

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top