CHOOSE TO STOP A MACRO OR NOT

[Alex Martins]

Hi. Is there a way to have a macro constantly running and to stop it by
clocking on a msg box?

For example. I have a macro that performs a repetitive operation over and
over. And that's what I want it to do! But at the end of the day, I wan to be
able to stop the macro. I tould be great to have a button in a msg box that
went:

"CLICK "OK" TO STOP RUNNING", and if I did, it would stop the code from
executing.

Any ideas?

Many thanks in advance. You've all been very helpful more than once!
Alex

 

[Myrna Larson]

You can certainly modify the existing code to, at the end of the repetitive
operation, check the system clock and if it's after a certain time, show the
message box, something like this:

If (Now() - Int(Now())) > TimeSerial(17, 0, 0) Then 'after 5 PM
If MsgBox("Stop running now?", vbYesNo) = vbYes Then Exit Sub
End If

But note that the above code will sit and wait for you to answer Yes or No. It
won't go on to the next repetition if you don't click a button within a
certain period of time.

 

[Jim Thomlinson]

Here is some code that allows you to halt macro exectuion when Esc is
pressed...

Private Sub Evaluate(ByVal total As Double, ByVal pos As Integer)
On Error GoTo HandleCancel
Application.EnableCancelKey = xlErrorHandler
'Do your stuff
Exit Sub

HandleCancel:
If Err = 18 Then
If MsgBox("Do you want to stop?", vbYesNo, "Quit?") = vbYes Then
Application.StatusBar = False
End
Else
Resume
End If
End If
End Sub

 

[Jim Thomlinson]

Sorry the code I posted is a sub that requires two arguments which is
probably not what you need. You just need to remove the two arguments...
Kinda like this. Apparently I need to be a bit more careful with my cut and
paste...

Private Sub Evaluate()
On Error GoTo HandleCancel
Application.EnableCancelKey = xlErrorHandler
'Do your stuff
Exit Sub

HandleCancel:
If Err = 18 Then
If MsgBox("Do you want to stop?", vbYesNo, "Quit?") = vbYes Then
Application.StatusBar = False
End
Else
Resume
End If
End If
End Sub

 

[Alex Martins]

Hey Jim first of thanks for your answer! I think your solution is what I
need, but I have a problem inserting the code becaus eI already have the
Private sub code written elsewhere.

This is the code with the the previous private sub and the the operative
part. If it is not too much trouble, could you please show me hoy to insert
it in here?

A million thanks for all your help man.
Alex

CODE:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Worksheets("NEW FILINGS").Range("F2")) Is Nothing
Then
If Worksheets("NEW FILINGS").Range("F2").Value = 0 Then
Call GetReported
Else
Call GetReports
End If
End If
End Sub


Sub GetReported()
'Dim strCnn As String
strCnn = "URL;" & Worksheets("NEW FILINGS").Range("B6").Text
With Worksheets("NEW FILINGS").QueryTables.Add(Connection:=strCnn,
Destination:=Worksheets("NEW FILINGS").Range("B10"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingRTF
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("NEW FILINGS").Range("$H$2").Select
Selection.Copy
Sheets("NEW FILINGS").Range("$F$2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

 

[Alex Martins]

Thanks Myrna. I tried it, but it froze the whole excel until I pressed ok!
And I need it to keep running because of other parts of my job!

Thanks a million for you answer.
Alex

 

[Jim Thomlinson]

Something like this...

Sub GetReported()
Dim strCnn As String

On Error GoTo HandleCancel
Application.EnableCancelKey = xlErrorHandler

strCnn = "URL;" & Worksheets("NEW FILINGS").Range("B6").Text
With Worksheets("NEW FILINGS").QueryTables.Add(Connection:=strCnn,
Destination:=Worksheets("NEW FILINGS").Range("B10"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingRTF
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("NEW FILINGS").Range("$H$2").Select
Selection.Copy
Sheets("NEW FILINGS").Range("$F$2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Exit Sub

HandleCancel:
If Err = 18 Then
If MsgBox("Do you want to stop?", vbYesNo, "Quit?") = vbYes Then
Application.StatusBar = False
End
Else
Resume
End If
End If
End Sub

 

[Alex Martins]

Thanks Jim. It worked like a charm! I had trouble logging on and couldn't
reply earlier.

Thanks again.
Alex

 

[Myrna Larson]

Yes, as I said, "the above code will sit and wait for you to answer Yes or
No". That's the problem with a message box. If you use a custom form, I
believe you have the option to make it non-modal.