Good, but could be better!

[AndrewKent]

Hi folks,

I have written this routine to extract data from a webpage and import into Excel. It works really well but it's slow and I have the feeling it could be better:

Sub OddsChecker_ImportData()

'   =============================================================================================
'   Procedure written by: Andrew Kent
'   Email: andrewkent1981@gmail.com

'   This procedure works as part of the BetUtopia Toolkit and should not be used for any other
'   purpose without the authors prior consent.
'   =============================================================================================

    Dim strActiveMatchData As String
    Dim lngActiveMatch As Long
    Dim lngLastMatch As Long

    lngActiveMatch = 8
    lngLastMatch = Worksheets("OddsChecker Data").Range("B" & Range("B1048576").End(xlUp).Row & "").Row
    strActiveMatchData = Worksheets("OddsChecker Data").Range("B" & lngActiveMatch & "").Value

    Do Until strActiveMatchData = ""
        Application.StatusBar = "Importing match " & lngActiveMatch - 7 & " of " & lngLastMatch - 7 & ", please wait..."
        With Worksheets("OddsChecker Scraper")
            .Select
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & strActiveMatchData & "", Destination:=Range("$B$16"))
                .Name = "Table 1"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = False
                .RefreshStyle = xlOverwriteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "2"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & strActiveMatchData & "", Destination:=Range("$B$21"))
                .Name = "Table 2"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = False
                .RefreshStyle = xlOverwriteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "4"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            If Worksheets("OddsChecker Scraper").Range("C27").Value = "" Then
                .Range("OCS_Table2").ClearContents
                .Range("OCS_Table2").QueryTable.Delete
                With ActiveSheet.QueryTables.Add(Connection:="URL;" & strActiveMatchData & "", Destination:=Range("$B$21"))
                    .Name = "Table 2"
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .BackgroundQuery = False
                    .RefreshStyle = xlOverwriteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = False
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingNone
                    .WebTables = "3"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .WebSingleBlockTextImport = False
                    .WebDisableDateRecognition = True
                    .WebDisableRedirections = False
                    .Refresh BackgroundQuery:=False
                End With
            End If
            Worksheets("OddsChecker Data").Range("F" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("C6").Value
            Worksheets("OddsChecker Data").Range("G" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("C7").Value
            Worksheets("OddsChecker Data").Range("H" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("C8").Value
            Worksheets("OddsChecker Data").Range("I" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AA11").Value
            Worksheets("OddsChecker Data").Range("J" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AA13").Value
            Worksheets("OddsChecker Data").Range("K" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AA12").Value
            Worksheets("OddsChecker Data").Range("L" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AB11").Value
            Worksheets("OddsChecker Data").Range("M" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AB13").Value
            Worksheets("OddsChecker Data").Range("N" & lngActiveMatch & "").Value = Worksheets("OddsChecker Scraper").Range("AB12").Value
            .Range("OCS_Table1").ClearContents
            .Range("OCS_Table1").QueryTable.Delete
            .Range("OCS_Table2").ClearContents
            .Range("OCS_Table2").QueryTable.Delete
        End With
        lngActiveMatch = lngActiveMatch + 1
        strActiveMatchData = Worksheets("OddsChecker Data").Range("B" & lngActiveMatch & "").Value
    Loop
    With Worksheets("OddsChecker Data")
        .Select
        .Range("I8:N" & Range("I1048576").End(xlUp).Row & "").Replace What:="#N/A", Replacement:="-", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
        .Range("A1").Select
    End With
    Application.StatusBar = False
    
End Sub

Could anyone offer any improvements for extracting data from a webpage?

Kind regards,

Andy

 

[wigi]

Andy,

what is immediately clear (and will perhaps not be a big performance gain, code maintainability is worth a lot too):

- you should use arrays and work in memory, to speed up data transfers between worksheets
- use the With...End With statement a lot more than you do now
- do not .Select sheets
- I1048576 is actually better coded as "I" & Rows.Count
- something like the & "" in:
Range("I8:N" & Range("I1048576").End(xlUp).Row & "")
is nonsense. You want to convert the row number in front to a string? The & after :N" already converts the row number to a string. In fact, you even add & "" to strings?
- when you add a querytables connection to a URL, you do not need to speficy all these arguments. What you have now is macro recorder code...
- ... and so on

 

[gsistek]

Also, disabling events and screenupdating can boost speed a lot.

 

[AndrewKent]

Thanks for the tips guys,

The screen updating and events are part of a routine that controls this one so I have that covered.

Some of the arguments within the query tables are needed but I can remove the ones that aren't.

Does selecting the worksheet slow things down?

And finally, is there a quicker way to get data out of a webpage other than using a query table?

Andy