macro to pause code, another to resume

DerekF · Jul 27, 2007

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

APOC [T.I.M.] · Aug 30, 2007

do you find anything allready?

APOC [T.I.M.] · Sep 1, 2007

I don't now for sure, but perhaps this is something you can use?
http://www.mrexcel.com/board2/viewtopic.php?p=1399362#1399362

Norie · Sep 1, 2007

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.

DerekF · Nov 1, 2007

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.

DerekF · Nov 1, 2007

Legacy 98055 · Nov 1, 2007

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 · Nov 2, 2007

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

Legacy 98055 · Nov 2, 2007

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

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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

</td></tr></table><button onclick='document.all("112200714751166").value=document.all("112200714751166").value.replace(/ \s\s/g,"");document.all("112200714751166").value=document.all("112200714751166").value.replace(/ /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 · Nov 21, 2007

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?

macro to pause code, another to resume

DerekF

Board Regular

Excel Facts

APOC [T.I.M.]

Board Regular

APOC [T.I.M.]

Board Regular

Norie

Well-known Member

DerekF

Board Regular

DerekF

Board Regular

Legacy 98055

Guest

DerekF

Board Regular

Legacy 98055

Guest

DerekF

Board Regular

Similar threads

Forum statistics

Share this page

macro to pause code, another to resume

Board Regular

Excel Facts

Board Regular

Board Regular

Well-known Member

Board Regular

Board Regular

Legacy 98055

Guest

Board Regular

Legacy 98055

Guest

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock