extract figures from a html table out of yahoo finance | Excel VBA webscraping

Question

Hi I need help with this code I'm trying to extract data from this page, "Earnings History" block: https://finance.yahoo.com/quote/MSFT/analysis?p=MSFT

Been sitting & frustrating on this for already 4 hours. Any help/hint is highly appreciated!

Regards Milan

Dim objIE As InternetExplorer
Dim aEle As HTMLDocument
Dim y As Long
Dim x As String
Dim lastrow As Long

Set objIE = New InternetExplorer

objIE.Visible = True

lastrow = Sheets("Table5").usedrange.Row - 1 + Sheets("Table5").usedrange.Rows.Count


For y = 11 To lastrow Step 2

x = Sheets("Table5").Range("A" & y).Value
If x = "" Then
Exit Sub
Else
objIE.navigate "https://finance.yahoo.com/quote/" & x & "/analysis?p=" & x

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

        For Each aEle In objIE.document.getElementsByClassName("BdT Bdc($seperatorColor)")
    
        'On Error Resume Next
        If InStr(aEle.innerText, "EPS Actual") > 0 Then
        Sheets("Table5").Range("T" & y).Value = aEle.Children(4).innerText
        Sheets("Table5").Range("U" & y).Value = aEle.Children(3).innerText
        Sheets("Table5").Range("V" & y).Value = aEle.Children(2).innerText
        Sheets("Table5").Range("W" & y).Value = aEle.Children(1).innerText

        Exit For
        End If
        Next
       
    
End If
Next y
End Sub

Answer 1

You can get the content across the row EPS Actua out of the table Earnings History from that site using xmlhttp requests. You don't need to go for IE. Give it a shot.

Sub FetchValue()
    Const Url$ = "https://finance.yahoo.com/quote/MSFT/analysis?p=MSFT&guccounter=1"
    Dim elem As Object, tRow As Object, S$, R&

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.121 Safari/537.36"
        .Send
        S = .responseText
    End With
    
    With CreateObject("HTMLFile")
        .write S
        For Each elem In .getElementsByTagName("tr")
            If InStr(elem.innerText, "EPS Actual") > 0 Then
                R = R + 1: Cells(R, 1) = elem.Children(1).innerText
                Cells(R, 2) = elem.Children(2).innerText
                Cells(R, 3) = elem.Children(3).innerText
                Cells(R, 4) = elem.Children(4).innerText
                Exit For
            End If
        Next elem
    End With
End Sub