Excel VBA web scraper Google finance

Macro that scrapes web data from Google Finance page.  You input a list of Tickers and run the macro which goes to Google finance and pulls the stats for the list of tickers.

 

Google Finance Web Scraper (91 downloads)

 

Output of macro:

web-scraper-google-finance
Option Explicit
Sub WebScrape()
Dim tickerLength, nextIs, i As Long
Dim doc, hcol, text As Variant
Dim ticker As String
Dim currentInnerHtml As String
currentInnerHtml = ""
Dim ie As SHDocVw.InternetExplorer
tickerLength = WorksheetFunction.CountA(Columns(1))
For i = 2 To tickerLength - 1
ticker = Cells(i + 1, 1).Value
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate ("https://www.google.com/finance?q=" & ticker)
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
    Loop
    While ie.Busy
    DoEvents
    Wend
    Set doc = ie.Document
    Set hcol = doc.getElementsByTagName("td")
        For Each text In hcol

            If currentInnerHtml = "Range" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 2).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "52 week" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 3).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Open" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 4).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "volavg" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 5).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Mkt" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 6).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "PE" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 7).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "DivY" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 8).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "EPS" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 9).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Shares" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 10).Value = text.innerhtml
                End If
             ElseIf currentInnerHtml = "Beta" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 11).Value = text.innerhtml
                End If
            ElseIf currentInnerHtml = "Inst" Then
                currentInnerHtml = ""
                If InStr(1, text.innerhtml, "<", vbTextCompare) = 0 And InStr(1, text.innerhtml, "&", vbTextCompare) = 0 Then
                    Cells(i + 1, 12).Value = text.innerhtml
                End If
            End If

            If InStr(1, text.innerhtml, "Range", vbTextCompare) > 0 Then
                currentInnerHtml = "Range"
            ElseIf InStr(1, text.innerhtml, "52 week", vbTextCompare) > 0 Then
                 currentInnerHtml = "52 week"
            ElseIf InStr(1, text.innerhtml, "Open", vbTextCompare) > 0 Then
                currentInnerHtml = "Open"
            ElseIf InStr(1, text.innerhtml, "Vol", vbTextCompare) > 0 Then
                currentInnerHtml = "volavg"
            ElseIf InStr(1, text.innerhtml, "Mkt cap", vbTextCompare) > 0 Then
                currentInnerHtml = "Mkt"
            ElseIf InStr(1, text.innerhtml, "P/E", vbTextCompare) > 0 Then
                currentInnerHtml = "PE"
            ElseIf InStr(1, text.innerhtml, "Div/yield", vbTextCompare) > 0 Then
                currentInnerHtml = "DivY"
            ElseIf InStr(1, text.innerhtml, "EPS", vbTextCompare) > 0 Then
                currentInnerHtml = "EPS"
            ElseIf InStr(1, text.innerhtml, "Shares", vbTextCompare) > 0 Then
                currentInnerHtml = "Shares"
            ElseIf InStr(1, text.innerhtml, "Beta", vbTextCompare) > 0 Then
                currentInnerHtml = "Beta"
            ElseIf InStr(1, text.innerhtml, "Inst", vbTextCompare) > 0 Then
                currentInnerHtml = "Inst"
            End If
        Next

Next i
End Sub

*Note: Microsoft Internet Controls Reference must be enabled