Macro Amendment

[SHARPY1]

Hi,
I have a macro that was written for me some years back by a user, that scraped data from a website.
It is now in need of updating as the website has updated/changed a little.

basically i get sports results and fixtures from the website, usually 2 or 3 times per week.
It was set up so that i could get a whole range of dates of results or fixtures. i.e. results for a certain month etc, each would return on a different tab for each day.
Would also be great to get results for just a particular league too.

data used to return in this format
Date League Fixture Team1 Team2
28.10.2017 Africa: CAF Champions League Al Ahly - Wydad Al Ahly Wydad
28.10.2017 Albania: Super League Lushnja - Teuta Lushnja Teuta
28.10.2017 Albania: Super League Skenderbeu - Luftetari Gjirokastra Skenderbeu Luftetari Gjirokastra

displayed in 5 columns, each day on a different tab.

If anybody could help, it would be so greatly appreciated.
Many thanks
Macro is shown below:

Sub Ombir_13Dec16()
Dim i As Long
Dim j As Long
Dim rw As Long
Dim cl As Long
Dim url As String
Dim mdate As String
Dim leagname As String
Dim matchdate As String
Dim output() As String
Dim dt As String
Dim ele As Variant
Dim daterng As Variant
Dim Doc As HTMLDocument
Dim ie As InternetExplorer
Dim league As HTMLTableSection
Dim leagues As IHTMLElementCollection
Dim ws As Worksheet

mdate = InputBox("Enter Match date/dates in dd/mm/yyyy format." & vbCrLf & _
vbCrLf & "For ex :" & vbCrLf & vbCrLf & "14/12/2016" & vbCrLf & vbCrLf & "or" _
& vbCrLf & vbCrLf & "10/12/2016,11/12/2016,12/12/2016,13/12/2016")

If InStr(mdate, ",") Then
daterng = Split(mdate, ",")
Else
ReDim daterng(1 To 1)
daterng(1) = mdate
End If

For Each ele In daterng

If Not IsDate(ele) Then
MsgBox "Incorrect Date"
Exit Sub
End If

dt = Replace(ele, "/", "-")

On Error Resume Next
Set ws = ThisWorkbook.Worksheets(dt)
If ws Is Nothing Then
ThisWorkbook.Worksheets.Add().Name = dt
Set ws = ThisWorkbook.Worksheets(dt)
End If
On Error GoTo 0

ws.UsedRange.Clear
Set ie = New InternetExplorer
url = "http://www.betexplorer.com/results/soccer/?year=" & Split(dt, "-")(2) & "&month=" & Split(dt, "-")(1) & "&day=" & Split(dt, "-")(0)

With ie
.Visible = True
.Navigate url
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
End With

Set Doc = ie.Document
Set leagues = Doc.getElementsByClassName("table-matches js-nrbanner-t")(0).getElementsByTagName("tbody")

ReDim output(1 To leagues.Length * 15, 1 To 11)
i = 0

For Each league In leagues
With league
If .className <> "js-nrbanner-tbody h-display-none" Then

leagname = Application.Clean(.Children(0).innerText)
matchdate = Doc.getElementsByClassName("in-date-navigation__cal js-window-trigger")(0).innerText

For rw = 1 To .Rows.Length - 1
j = 0
If .Rows(rw).className <> "js-newdate" Then
i = i + 1: j = j + 1
output(i, j) = matchdate
output(i, j + 1) = leagname
output(i, j + 2) = .Rows(rw).Cells(0).Children(0).innerText
output(i, j + 3) = .Rows(rw).Cells(0).Children(1).innerText
output(i, j + 4) = Split(output(i, j + 3), "- ")(0)
output(i, j + 5) = Split(output(i, j + 3), "- ")(1)
j = 7
For cl = 1 To .Rows(rw).Cells.Length - 1
output(i, j) = .Rows(rw).Cells(cl).innerText
j = j + 1
Next
Else
matchdate = .Rows(rw).innerText
End If
Next
End If
End With
Next
ie.Quit
ws.Range("A1:K1") = Array("Date", "League", "Time", "Fixture", "Team1", "Team2", "Col1", "Col2", "Col3", "Col4", "Col5")
ws.Range("A1:K1").Interior.ThemeColor = xlThemeColorAccent1
ws.Range("A2").Resize(UBound(output, 1), UBound(output, 2)) = output
With ws.UsedRange
.Columns.AutoFit
.Borders.Weight = xlThin
.WrapText = False
End With
Set ws = Nothing
Next
End Sub

 

[SHARPY1]

Is anybody able to help please?
don't mind paying for your time

thanks

 

[SHARPY1]

Anybody?
pretty please...

 

[SHARPY1]

anyone out there able to help please?

 

[Ombir]

Due to some busy schedule now a days, I'm not able to visit the forum.

I've made the changes. Try this:

Sub Ombir_18Nov18()
Dim i As Long
Dim j As Long
Dim rw As Long
Dim cl As Long
Dim url As String
Dim mdate As String
Dim leagname As String
Dim matchdate As String
Dim output() As String
Dim dt As String
Dim ele As Variant
Dim daterng As Variant
Dim Doc As HTMLDocument
Dim ie As InternetExplorer
Dim league As HTMLTableSection
Dim leagues As IHTMLElementCollection
Dim ws As Worksheet

mdate = InputBox("Enter Match date/dates in dd/mm/yyyy format." & vbCrLf & _
vbCrLf & "For ex :" & vbCrLf & vbCrLf & "14/12/2016" & vbCrLf & vbCrLf & "or" _
& vbCrLf & vbCrLf & "10/12/2016,11/12/2016,12/12/2016,13/12/2016")

If InStr(mdate, ",") Then
    daterng = Split(mdate, ",")
    Else
    ReDim daterng(1 To 1)
    daterng(1) = mdate
End If

For Each ele In daterng
    If Not IsDate(ele) Then
    MsgBox "Incorrect Date"
    Exit Sub
End If

dt = Replace(ele, "/", "-")

On Error Resume Next
Set ws = ThisWorkbook.Worksheets(dt)
If ws Is Nothing Then
    ThisWorkbook.Worksheets.Add().Name = dt
    Set ws = ThisWorkbook.Worksheets(dt)
End If
On Error GoTo 0

ws.UsedRange.Clear
Set ie = New InternetExplorer
url = "https://www.betexplorer.com/results/soccer/?year=" & Split(dt, "-")(2) & "&month=" & Split(dt, "-")(1) & "&day=" & Split(dt, "-")(0)

With ie
    .Visible = True
    .Navigate url
    Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
End With

Set Doc = ie.Document
Set leagues = Doc.getElementsByClassName("table-main js-nrbanner-t")(0).getElementsByTagName("tbody")

ReDim output(1 To leagues.Length * 15, 1 To 11)
i = 0

For Each league In leagues
With league
    If .className <> "js-nrbanner-tbody h-display-none" Then
    
    leagname = Application.Clean(.Children(0).innerText)
    matchdate = Doc.getElementsByClassName("in-date-navigation__cal js-window-trigger")(0).innerText
    
    For rw = 1 To .Rows.Length - 1
        j = 0
        If .Rows(rw).className <> "js-newdate" Then
            i = i + 1: j = j + 1
            output(i, j) = matchdate
            output(i, j + 1) = leagname
            output(i, j + 2) = .Rows(rw).Cells(0).Children(0).innerText
            output(i, j + 3) = .Rows(rw).Cells(0).Children(1).innerText
            output(i, j + 4) = Split(output(i, j + 3), "- ")(0)
            output(i, j + 5) = Split(output(i, j + 3), "- ")(1)
            j = 7
            For cl = 1 To .Rows(rw).Cells.Length - 1
                output(i, j) = .Rows(rw).Cells(cl).innerText
                j = j + 1
            Next
        Else
            matchdate = .Rows(rw).innerText
        End If
    Next
    End If
End With
Next
ie.Quit
ws.Range("A1:K1") = Array("Date", "League", "Time", "Fixture", "Team1", "Team2", "Col1", "Col2", "Col3", "Col4", "Col5")
ws.Range("A1:K1").Interior.ThemeColor = xlThemeColorAccent1
ws.Range("A2").Resize(UBound(output, 1), UBound(output, 2)) = output
With ws.UsedRange
    .Columns.AutoFit
    .Borders.Weight = xlThin
    .WrapText = False
End With
Set ws = Nothing
Next
End Sub