Button to interrupt subroutine

[DanOfEarth]

On the crawler I built, it takes up to thirty minutes to check the whole database via a do-with loop.

Is there a way to have an input box or equivilent that will hang there "stop" it in midstream if pressed? I've been trying DoWhile and DoUntil methods without any luck.

[mdmackillop]

There may be better ways to do this using arrays. Can you post your code and possibly a sample workbook?

[DanOfEarth]

Here's the routine:

[vba]Sub QueryMLS()

Const MyUrl As String = "http://search.har.com/engine/doSearch.cfm?QUICKSEARCH="
Sheets("Import").Visible = True
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)

With Sheets("Leads")
Set Address = ActiveCell
Set Street = ActiveCell.Offset(0, 1)

End With

With Sheets("Import").QueryTables.Add(Connection:= _
"URL;" & MyUrl & Address & " " & Street _
, Destination:=Sheets("Import").Range("Import!$A$1"))
.Name = "doSearch.cfm?QUICKSEARCH=802%20Hallmark%20Oak"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If Range("Results") = "Search Result: (0) Records Found. " Then
ActiveCell.Offset(0, 5).Formula = "Z - N/A"
ActiveCell.Offset(0, 6).Formula = "Z - N/A"


ElseIf Range("Results") = "Search Result: (1) Records Found. " Then
ActiveCell.Offset(0, 5).Formula = Range("AgentName")
ActiveCell.Offset(0, 6).Formula = Range("AgentFirm")

Else
ActiveCell.Offset(0, 5).Formula = "Z - Townhouse"
ActiveCell.Offset(0, 6).Formula = "Z - Townhouse"
ActiveCell.Offset(0, 7).Formula = "Z - Townhouse"

End If

ActiveCell.Offset(0, 8).Formula = Date


ActiveCell.Offset(1, 0).Select
Loop
Sheets("Import").Visible = False

End Sub[/vba]

It data-mines or "scrapes" a web page's search function and pastes results into my workbook.

[mdmackillop]

A simple Start/Stop routine. Assign a button to each.
[VBA]
Sub DoStart()
Dim i
Do Until Range("A1").Value = "Stop"
i = i + 1
Cells(1, 2) = i
DoEvents
Loop
Cells(1, 1).ClearContents
End Sub

Sub DoStop()
Cells(1, 1) = "Stop"
End Sub

[/VBA]

[DanOfEarth]

Well,

I gave that a shot. What happens is that while the subroutine is working, the hour-glass pointer stays on....not able to hit the "Stop" button while running.

Hmmmm.

[mdmackillop]

Sorry, without some data, I can't test using your code.

[DanOfEarth]

Thanks mac. That's O.K. I put it on the back burner for now, because I've got another bigger issue on that same subroutine that I'm posting that I hope I can fix. Ironically it's basically shut down the very subroutine I was trying "shut down" with that very button, so to speak.

But if I can get it to work, I'll have a somewhet sophisticated web-crawler. I'm shocked at some of the stuff I've been able to program recently.