Get Data from Website in a Specific Format (Excel VBA) - vba

Question

I am trying to pull data from a website (https://www.baseball-reference.com/teams/ARI/2017-schedule-scores.shtml) by using the following code:
Sub GetBaseballReferenceData()
'created loop so we can loop through all different team url's
Dim x As Integer
Dim i As Integer
For i = 1 To 30
x = Cells(Rows.Count, 2).End(xlUp).Row
x = x + 2
'gets the team abbreviation that we use in our url
Team = Cells(i, "A")
'these two strings are used for url, they don't change
Const bbref_site As String = "https://www.baseball-reference.com/teams/"
Const year_schedule_scores As String = "/2017-schedule-scores"
Dim qt As QueryTable
Dim ws As Worksheet
Set ws = ActiveSheet
'uses Url to return data
Set qt = ws.QueryTables.Add(Connection:="URL;" & bbref_site & Team & year_schedule_scores & ".shtml", Destination:=Cells(x, 2))
qt.Refresh BackgroundQuery:=False
Next i
End Sub
When I run the code it works and gets me the information I want. However, the W/L column should be formatted like this (1-2, 2-3, 3-0) and instead will be formatted as a date. When I try to reformat it as a text it returns an error code. How do I pull the data I want from the website as a text initially?
Thanks for any and all help!

Answer 1

I changed the code slightly
Edit: Added qt.WebDisableDateRecognition
Option Explicit
Sub GetBaseballReferenceData()
'created loop so we can loop through all different team url's
Dim x As Integer
Dim i As Integer
Dim Team As String
Dim qt As QueryTable
Dim ws As Worksheet
Dim WLRange As Range
'these two strings are used for url, they don't change
Const bbref_site As String = "https://www.baseball-reference.com/teams/"
Const year_schedule_scores As String = "/2017-schedule-scores"
Set ws = ActiveSheet
For i = 1 To 1
x = Cells(Rows.Count, 2).End(xlUp).Row
x = x + 2
'gets the team abbreviation that we use in our url
Team = Cells(i, "A")
'uses Url to return data
Set qt = ws.QueryTables.Add(Connection:="URL;" & bbref_site & Team & year_schedule_scores & ".shtml", Destination:=Cells(x, 2))
qt.WebDisableDateRecognition = True
qt.Refresh False
'qt.Refresh BackgroundQuery:=False
Next i
End Sub

Answer 2

You can also use XHR
Option Explicit
Public Sub GetSchedules()
Dim x As Long, i As Long, URL As String, Team As String
Const bbref_site As String = "https://www.baseball-reference.com/teams/"
Const year_schedule_scores As String = "/2017-schedule-scores"
Dim sResponse As String, HTML As New HTMLDocument, wsSchedule As Worksheet, wsTeam As Worksheet
Dim wb As Workbook: Set wb = ThisWorkbook
Set wsSchedule = wb.Worksheets("Schedules"): Set wsTeam = wb.Worksheets("TeamNames")
wsSchedule.Cells.ClearContents
Application.ScreenUpdating = False
Dim http As Object: Set http = CreateObject("MSXML2.XMLHTTP")
With wsTeam
For i = 1 To 30
Team = .Cells(i, "A")
URL = bbref_site & Team & year_schedule_scores & ".shtml"
http.Open "GET", URL, False
http.send
sResponse = StrConv(http.responseBody, vbUnicode)
sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))
With HTML
.body.innerHTML = sResponse
End With
WriteTable HTML, GetLastRow(wsSchedule, 1) + 2, wsSchedule
Next i
Application.ScreenUpdating = True
End With
End Sub
Public Sub WriteTable(ByVal HTML As HTMLDocument, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
Dim headers As Object, i As Long, columnCounter As Long
Dim columnInfo As Object, rowCounter As Long
With ws
Set headers = HTML.querySelectorAll("#team_schedule thead th")
For i = 0 To headers.Length - 1
columnCounter = columnCounter + 1
.Cells(startRow, columnCounter) = headers.item(i).innerText
Next i
Set columnInfo = HTML.querySelectorAll("#team_schedule tbody tr td")
columnCounter = 2
For i = 0 To columnInfo.Length - 1
If i Mod 20 = 0 Then
rowCounter = rowCounter + 1
columnCounter = 2
.Cells(startRow + rowCounter, 1) = rowCounter
Else
columnCounter = columnCounter + 1
End If
If columnCounter = 11 Then
.Cells(startRow + rowCounter, columnCounter) = Chr$(39) & columnInfo.item(i).innerText
Else
.Cells(startRow + rowCounter, columnCounter) = columnInfo.item(i).innerText
End If
Next i
End With
End Sub