Parse/Scrape column from table using MSHTML.HTMLDocument - html

Question

I wrote this piece of code that scrapes the whole table from the webpage in the URL variable. I would like to only scrape/parse the column by the name
"Extrapolated Vol".
My html/xml is not strong, so a solution along with an explanation would be appreciated!
https://services.tcpl.ca/cor/public/gdsr/GdsrNGTLImperial20151122.htm
Thanks
Sub ExtractAlbertaAIL()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim URL As String
Dim Request As MSXML2.XMLHTTP
Dim doc As MSHTML.HTMLDocument
Dim tr As MSHTML.HTMLGenericElement
Dim td As MSHTML.HTMLGenericElement
Dim RowNumber As Integer
Dim ColNumber As Integer
ActiveWorkbook.Worksheets("Gas Day Summary").Range("A5:H10000") = ""
Set Request = CreateObject("msxml2.xmlhttp")
If Request Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object"
Exit Sub
End If
URL = "https://services.tcpl.ca/cor/public/gdsr/GdsrNGTLImperial20151122.htm"
With Request
.Open "GET", URL, False
.send
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
End With
RowNumber = 1
For Each tr In doc.getElementsByTagName("table").Item(2).getElementsByTagName("tr")
ColNumber = 1
For Each td In tr.getElementsByTagName("td")
Worksheets("Gas Day Summary").Cells(RowNumber, ColNumber) = td.innerText
ColNumber = ColNumber + 1
Next td
RowNumber = RowNumber + 1
Next tr
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 1

Try this
Sub ExtractAlbertaAIL()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim URL As String
Dim Request As MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim tr As MSHTML.HTMLGenericElement
Dim td As MSHTML.HTMLGenericElement
Dim VOLUME_SUMMARY_FOUND As Boolean
VOLUME_SUMMARY_FOUND = False
Dim RowNumber As Integer
Dim ColNumber As Integer
ActiveWorkbook.Worksheets("Gas Day Summary").Range("A5:H10000") = ""
Set Request = CreateObject("msxml2.xmlhttp")
If Request Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object"
Exit Sub
End If
URL = "https://services.tcpl.ca/cor/public/gdsr/GdsrNGTLImperial20151122.htm"
With Request
.Open "GET", URL, False
.send
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
End With
RowNumber = 1
For Each tr In doc.getElementsByTagName("table").Item(2).getElementsByTagName("tr")
If tr.Cells(0).innerText = "VOLUME SUMMARY" Then
VOLUME_SUMMARY_FOUND = True
End If
If VOLUME_SUMMARY_FOUND = True Then
Worksheets("Gas Day Summary").Cells(RowNumber, 1) = tr.Cells(0).innerText
Worksheets("Gas Day Summary").Cells(RowNumber, 2) = tr.Cells(2).innerText
RowNumber = RowNumber + 1
End If
Next tr
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
​