Old scraping algorithm.




Sub Get_Odds_Data(ByRef CurrentSheet As String)

Dim URL As String
Dim XMLreq As Object
Dim HTMLdoc As Object
Dim OddsTable As Object
Dim tableRows As Object
Dim tableCell As Object
Dim dest As Range
Dim OddsData As Variant
Dim HTMLrow As Integer, i As Integer, C As Integer
Dim AString As String
Dim AnInt As Integer



Set dest = Sheets(CurrentSheet).Cells(31, 1)
dest.Parent.Activate

On Error GoTo keeppreviousread

URL = Sheets(CurrentSheet).Cells(1, 27)
Set XMLreq = CreateObject("MSXML2.XMLhttp")

HTMLrow = 0

With XMLreq
Debug.Print Now, URL
.Open "GET", URL, False
.send
Set HTMLdoc = CreateObject("HTMLFile")
HTMLdoc.body.innerHTML = .responseText
End With

'Extract table into array

Set OddsTable = HTMLdoc.GetElementById("t1") '
Set tableRows = OddsTable.Rows
ReDim OddsData(1 To tableRows.Length - HTMLrow + 1, 1 To tableRows(HTMLrow).Cells.Length)

i = 1
While HTMLrow < tableRows.Length
C = 1
AString = tableRows(HTMLrow).Cells(0).innerText
If IsNumeric(Mid(AString, 1, 1)) Then
FirstCell = True
For Each tableCell In tableRows(HTMLrow).Cells
If FirstCell <> True Then ' ignore first cell in row
OddsData(i, C) = tableCell.innerText
C = C + 1
End If
FirstCell = False
Next
i = i + 1
End If
HTMLrow = HTMLrow + 1

Wend

Worksheets(CurrentSheet).Range("A31:AA60").Clear
'Copy array to sheet cells
Set dest = dest.Offset(0, 0)
dest.Resize(UBound(OddsData, 1), UBound(OddsData, 2)).Value = OddsData
DoEvents
Set XMLreq = Nothing
Set HTMLdoc = Nothing
Set OddsTable = Nothing
Set tableRows = Nothing
Set tableCell = Nothing

Exit Sub
keeppreviousread:
Sheets(CurrentSheet).Cells(25, 2) = "xxxxxxxx"

End Sub