Option Explicit
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
