Power query Masters scoreboard

[JGordon11]

Can one use power query to download the masters scoreboard at https://www.masters.com/en_US/scores/index.html? If so, how?

 

[Worf]

I could not connect to that page using Power Query. Would you accept a VBA solution?

 

[JGordon11]

I couldn't connect either. I wrote a VBA work around that works (below). Couldn't get a sub to work without having to actually open IE. So interested if you have any suggestions on improving what I wrote. Power Query would have been nice because I can set it up to auto refresh every so often. Obviously not needed for the 2020 tournament scores but will be using it in 2021 as the tournament is live.

This works:

Sub ExtractTable()
Dim IE As New SHDocVw.InternetExplorer
IE.Visible = True
IE.navigate "https://www.masters.com/en_US/scores/"
Dim HTMLDoc As MSHTML.HTMLDocument
Dim Positions As MSHTML.IHTMLElementCollection
Dim Position As MSHTML.IHTMLElement

Dim a(1 To 1000, 1 To 10)
Do While IE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop

Set HTMLDoc = IE.document

Set Positions = HTMLDoc.getElementsByClassName("data")

t = Timer
Do While Timer - t < 5 And Positions.Length = 0
DoEvents
Loop
Debug.Print Timer - t

j = 1
ii = 1
newline = 10
For i = 0 To Positions.Length - 1
k = k + 1
a(ii, j) = Positions(i).innerText
If a(ii, j) = "MC" Then newline = 8
j = j + 1
If (i + 1) Mod newline = 0 Then
j = 1
ii = ii + 1
End If
Next
ActiveSheet.Range(Cells(1, 1), Cells(i, 10)) = a
IE.Quit
Set IE = Nothing
End Sub


This one fails:

Sub ExtractTable1()
Dim XMLPage As New MSXML2.XMLHTTP60

'IE.Visible = True
'IE.navigate "https://www.masters.com/en_US/scores/"
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim Positions As MSHTML.IHTMLElementCollection
Dim Position As MSHTML.IHTMLElement
Dim PlayerNames As MSHTML.IHTMLElementCollection
Dim PlayerName As MSHTML.IHTMLElement
Dim AmountUnders As MSHTML.IHTMLElementCollection
Dim AmountUnder As MSHTML.IHTMLElement
Dim a(1 To 1000, 1 To 10)
XMLPage.Open "GET", "https://www.masters.com/en_US/scores/", False
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText

Set Positions = HTMLDoc.getElementsByClassName("data")
Set PlayerNames = HTMLDoc.getElementsByClassName("data ")
Set AmountUnders = HTMLDoc.getElementsByClassName("data under")
t = Timer
Do While Timer - t < 5 And Positions.Length = 0
DoEvents
Loop
Stop
j = 1
ii = 1
For i = 0 To Positions.Length - 1
If (i + 1) Mod 10 = 0 Then
j = 1
ii = ii + 1
End If
k = k + 1
a(ii, j) = Positions(i).innerText
j = j + 1
Next
ActiveSheet.Range(Cells(1, 1), Cells(i, 10)) = a
Stop
Set IE = Nothing
End Sub

 

[lrobbo314]

I don't think that VBA will work either because they are using REACT to render the info on the page.

It works with Power Query on a different website though.

Book1 (version 1).xlsb
	A	B	C	D	E	F	G	H	I	J
1	POS	NAME	TOTAL	THRU	TODAY	R1	R2	R3	R4	TOTAL_1
2	1	Dustin Johnson	-20	F	-4	65	70	65	68	268
3	T2	Cameron Smith	-15	F	-3	67	68	69	69	273
4	T2	Sungjae Im	-15	F	-3	66	70	68	69	273
5	4	Justin Thomas	-12	F	-2	66	69	71	70	276
6	T5	Rory McIlroy	-11	F	-3	75	66	67	69	277
7	T5	Dylan Frittelli	-11	F	E	65	73	67	72	277
8	T7	C.T. Pan	-10	F	-4	70	66	74	68	278
9	T7	Brooks Koepka	-10	F	-2	70	69	69	70	278
10	T7	Jon Rahm	-10	F	-1	69	66	72	71	278
11	T10	Webb Simpson	-9	F	-4	67	73	71	68	279
Sheet7

let
    Source = Web.Page(Web.Contents("https://www.augusta.com/masters/leaderboard")),
    Data0 = Source{0}[Data],
    RemovedTopRows = Table.Skip(Data0,2),
    PromoteHeaders = Table.PromoteHeaders(RemovedTopRows, [PromoteAllScalars=true]),
    Types = Table.TransformColumnTypes(PromoteHeaders,{{"POS", type text}, {"NAME", type text}, {"TOTAL", type text}, {"THRU", type text}, {"TODAY", type text}, {"R1", Int64.Type}, {"R2", Int64.Type}, {"R3", Int64.Type}, {"R4", Int64.Type}, {"TOTAL_1", Int64.Type}}),
    KeptFirstRows = Table.FirstN(Types,10)
in
    KeptFirstRows

 

[JGordon11]

Thanks - that's great!

 

[Worf]

I don't think that VBA will work either because they are using REACT to render the info on the page.

For the record, there is working VBA code at the third post.