Completed

Scraping sports results from a website

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 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 = [login to view URL](dt)

If ws Is Nothing Then

[login to view URL]().Name = dt

Set ws = [login to view URL](dt)

End If

On Error GoTo 0

[login to view URL]

Set ie = New InternetExplorer

url = "[login to view URL]" & 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 = [login to view URL]

Set leagues = [login to view URL]("table-matches js-nrbanner-t")(0).getElementsByTagName("tbody")

ReDim output(1 To [login to view URL] * 15, 1 To 11)

i = 0

For Each league In leagues

With league

If .className <> "js-nrbanner-tbody h-display-none" Then

leagname = [login to view URL](.Children(0).innerText)

matchdate = [login to view URL]("in-date-navigation__cal js-window-trigger")(0).innerText

For rw = 1 To .[login to view URL] - 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).[login to view URL] - 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

[login to view URL]

[login to view URL]("A1:K1") = Array("Date", "League", "Time", "Fixture", "Team1", "Team2", "Col1", "Col2", "Col3", "Col4", "Col5")

[login to view URL]("A1:K1").[login to view URL] = xlThemeColorAccent1

[login to view URL]("A2").Resize(UBound(output, 1), UBound(output, 2)) = output

With [login to view URL]

.[login to view URL]

.[login to view URL] = xlThin

.WrapText = False

End With

Set ws = Nothing

Next

End Sub

Skills: Data Entry, Data Mining, Data Processing, Excel, Web Scraping

See more: displaying database results website, scraping google results, sports book website, scrape data from website to excel, scrape sports scores, web scraping sports data, google web scraping api, web scraping tool, web scraping espn, scraping football data, scrape mlb scores, sports handicapping website, show query results website, need create sports betting website, set sports handicapping website, buy sports picks website, sports betting website script code, set sports betting website, free cms sports club website, sports themed website

About the Employer:
( 1 review ) NOTTINGHAM, United Kingdom

Project ID: #18139413

Awarded to:

mateenbhatti94

Dear sir I have read the requirements and completely understand the project. I have been in this industry for 1 year and such jobs are my daily practice. I can assure you that if you work with me once, you will al More

£80 GBP in 3 days
(58 Reviews)
5.6

7 freelancers are bidding on average £102 for this job

AhmedSalahA

i can do you work and i need more description and do worry from any think .

£200 GBP in 3 days
(93 Reviews)
6.3
mtanveer2012

Hello boss, I can make script for you in python which will work fast then that old macro. Please message me so I can share further details.

£50 GBP in 1 day
(31 Reviews)
4.9
dataexplorer

"Hi, I have just gone through your project description and reviewed everything. Yes, I’m able to work as per your stated requirements in your current project. Also, I'm able to provide accurate and quick service. You More

£70 GBP in 3 days
(22 Reviews)
4.0
brilliant06

I define myself as a perfectionist. Who competes to beat his very own performance and then celebrates. This is something that brings me immense pleasure in the , I used to say, "I am a business student and intend to ho More

£111 GBP in 3 days
(8 Reviews)
3.3
Roxkstar

Professional software engineer from USA.

£150 GBP in 3 days
(0 Reviews)
0.0
tohamyeslam11198

Hi There! I have great experience in data entry and excel. I'm expert in this kind of work. I will do your work professionally and very fast. I will do this only for this low price and this is a kind offer for you. My More

£50 GBP in 1 day
(0 Reviews)
0.0