Procedure Freezing

[AndrewKent]

Hi there,

Bit of a tricky one here. I have written a procedure to extract data from a URL however it appears to be freezing.

If I step through the code (F8) it works fine for me however leaving it to run normally causes it to freeze. If I put in a breaker at "End" (which I placed in to see if that could finish the routine) and run it, it still freezes, until I press Esc to manually break the routine, at which point it breaks on the breaker that I have placed in.

When I say freezing, I mean that the Windows 7 circular busy icon is showing.

Sub SportingLife_ImportData()

'   =============================================================================================

'   =============================================================================================

    Dim strActiveMatchResult As String
    Dim strActiveMatchStats As String
    Dim intActiveMatchResult As Integer
    Dim intActiveMatchStats As Integer
    
    Dim strMatchID As String
    Dim strActiveDivision As String
    Dim strActiveMonth As String
    Dim intActiveYear As Integer
    Dim strHomeTeam As String
    Dim strAwayTeam As String
    Dim intHTGF As Integer
    Dim intATGF As Integer
    Dim strFTR As String
    Dim intHTSOnT As Integer
    Dim intATSOnT As Integer
    Dim intHTSOffT As Integer
    Dim intATSOffT As Integer
    Dim intHTTS As Integer
    Dim intATTS As Integer
    Dim intHTFC As Integer
    Dim intATFC As Integer
    Dim intHTCW As Integer
    Dim intATCW As Integer
    Dim intHTYC As Integer
    Dim intATYC As Integer
    Dim intHTRC As Integer
    Dim intATRC As Integer

    intActiveMatchResult = 9
    intActiveMatchStats = 9
    strActiveMatchResult = Worksheets("Sporting Life Result Scraper").Range("E" & intActiveMatchResult & "").Value
    strActiveMatchStats = Worksheets("Sporting Life Result Scraper").Range("F" & intActiveMatchStats & "").Value
    
    Call StartProcedure

    Do Until strActiveMatchResult = "" And strActiveMatchStats = ""
        If strActiveMatchResult = "-" And strActiveMatchResult = "-" Then
'           Do Nothing
        Else
            Sheets.Add.Name = "Extract Data"
            With Worksheets("Extract Data")
                .Select
                With ActiveSheet.QueryTables.Add(Connection:="" & strActiveMatchResult & "", Destination:=Range("$A$1"))
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .BackgroundQuery = True
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingNone
                    .WebTables = "2"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .WebSingleBlockTextImport = False
                    .WebDisableDateRecognition = True
                    .WebDisableRedirections = False
                    .Refresh BackgroundQuery:=False
                End With
                Range("B8").Select
                With ActiveSheet.QueryTables.Add(Connection:="" & strActiveMatchStats & "", Destination:=Range("$A$3"))
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .BackgroundQuery = True
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlAllTables
                    .WebFormatting = xlWebFormattingNone
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .WebSingleBlockTextImport = False
                    .WebDisableDateRecognition = True
                    .WebDisableRedirections = False
                    .Refresh BackgroundQuery:=False
                End With
                .Range("A1:C1").Copy
            End With
            With Worksheets("Sporting Life Result Scraper")
                .Select
                .Range("H9").PasteSpecial xlPasteValues
            End With
            With Worksheets("Extract Data")
                .Select
                .Range("A3:C10").Copy
            End With
            With Worksheets("Sporting Life Result Scraper")
                .Select
                .Range("L9").PasteSpecial xlPasteValues
            End With
            strMatchID = "SLID" & Worksheets("Sporting Life Result Scraper").Range("D" & intActiveMatchResult & "").Value
            strActiveDivision = Worksheets("File Locations").Range("S5").Value
            strActiveMonth = Worksheets("File Locations").Range("O5").Value
            intActiveYear = Worksheets("File Locations").Range("P5").Value
            strHomeTeam = Worksheets("Sporting Life Result Scraper").Range("H9").Value
            strAwayTeam = Worksheets("Sporting Life Result Scraper").Range("J9").Value
            intHTGF = Worksheets("Sporting Life Result Scraper").Range("I11").Value
            intATGF = Worksheets("Sporting Life Result Scraper").Range("I12").Value
            strFTR = Worksheets("Sporting Life Result Scraper").Range("I13").Value
            intHTSOnT = Worksheets("Sporting Life Result Scraper").Range("L10").Value
            intATSOnT = Worksheets("Sporting Life Result Scraper").Range("N10").Value
            intHTSOffT = Worksheets("Sporting Life Result Scraper").Range("L11").Value
            intATSOffT = Worksheets("Sporting Life Result Scraper").Range("N11").Value
            intHTTS = intHTSOnT + intHTSOffT
            intATTS = intATSOnT + intATSOffT
            intHTFC = Worksheets("Sporting Life Result Scraper").Range("L12").Value
            intATFC = Worksheets("Sporting Life Result Scraper").Range("N12").Value
            intHTCW = Worksheets("Sporting Life Result Scraper").Range("L13").Value
            intATCW = Worksheets("Sporting Life Result Scraper").Range("N13").Value
            intHTYC = Worksheets("Sporting Life Result Scraper").Range("L14").Value
            intATYC = Worksheets("Sporting Life Result Scraper").Range("N14").Value
            intHTRC = Worksheets("Sporting Life Result Scraper").Range("L15").Value
            intATRC = Worksheets("Sporting Life Result Scraper").Range("N15").Value
            Worksheets("Extract Data").Select
            ActiveWindow.SelectedSheets.Delete
            With Worksheets("Sporting Life Data")
                .Select
                .Range("B" & Range("B1048576").End(xlUp).Offset(1, 0).Row & "").Value = strMatchID
                .Range("C" & Range("C1048576").End(xlUp).Offset(1, 0).Row & "").Value = intActiveYear
                .Range("D" & Range("D1048576").End(xlUp).Offset(1, 0).Row & "").Value = strActiveDivision
                .Range("E" & Range("E1048576").End(xlUp).Offset(1, 0).Row & "").Value = strActiveMonth
                .Range("F" & Range("F1048576").End(xlUp).Offset(1, 0).Row & "").Value = strHomeTeam
                .Range("G" & Range("G1048576").End(xlUp).Offset(1, 0).Row & "").Value = strAwayTeam
                .Range("H" & Range("H1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTGF
                .Range("I" & Range("I1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATGF
                .Range("J" & Range("J1048576").End(xlUp).Offset(1, 0).Row & "").Value = strFTR
                .Range("K" & Range("K1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTSOnT
                .Range("L" & Range("L1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTSOffT
                .Range("M" & Range("M1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTTS
                .Range("N" & Range("N1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTFC
                .Range("O" & Range("O1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTCW
                .Range("P" & Range("P1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTYC
                .Range("Q" & Range("Q1048576").End(xlUp).Offset(1, 0).Row & "").Value = intHTRC
                .Range("R" & Range("R1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATSOnT
                .Range("S" & Range("S1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATSOffT
                .Range("T" & Range("T1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATTS
                .Range("U" & Range("U1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATFC
                .Range("V" & Range("V1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATCW
                .Range("W" & Range("W1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATYC
                .Range("X" & Range("X1048576").End(xlUp).Offset(1, 0).Row & "").Value = intATRC
            End With
        End If
        intActiveMatchResult = intActiveMatchResult + 1
        intActiveMatchStats = intActiveMatchStats + 1
        strActiveMatchResult = Worksheets("Sporting Life Result Scraper").Range("E" & intActiveMatchResult & "").Value
        strActiveMatchStats = Worksheets("Sporting Life Result Scraper").Range("F" & intActiveMatchStats & "").Value
        Application.Wait Now + TimeValue("00:00:01")
    Loop
    
    End
    
End Sub

Any idea why?

Andy