Web scraping data from US postal zip codes Web scraping county, population and median home value from United States postal zip codes.



I switched from using InternetExplorer.Application to New MSXML2.XMLHTTP60. For the first time, I broke code into smaller subs or functions, among other things.


This code ran successfully 1 time, with other tests returning only 70-100 records.
UsingInternetExplorer.Application, I projected the code to complete in 1H:45M by timing 20 records. With the XML method, I projected 25-30 min as it takes about 5 min to fetch 70-100 records. 
Excel goes completely blank when running (white screen).


There appears to be several things I can do:


Early binding (which I didn't understand how to implement based on the thread)
Creating VBScripts to simulate multi-threading; I've not created VBScripts with Excel so this option is taking me a little bit as I try to read and study VBScripts more in depth.
Can't seem to find the link, but elsewhere, I read that jumping around would make things slow. According to the thread, I should store all values in an array first, after all values are retrieved, I then should input them into the corresponding cells, instead of retrieving and inputting right away. (I think I can handle this but not sure if anyone has any pointers as to whether this actually works).




Variables

'ZipCodeScrape Variables
    Public ZipCodeRange As Range
    Public cell as Variant

'Web Variables
    Public IE As MSXML2.XMLHTTP60
    Public url As String
    Public post As Object
    Public HTML As MSHTML.HTMLDocument
    Public HTMLbody As MSHTML.HTMLbody


Gathering zip codes and using a function to retrieve data

Sub ZipCodeScrape()

    Set IE = New MSXML2.XMLHTTP60
    url = "https://www.unitedstateszipcodes.org/"

    Set ZipCodeRange = Range("C2", Range("C2").End(xlDown))

    Dim TargetElement(1 To 3) As String
        TargetElement(1) = "County:"
        TargetElement(2) = "Population"
        TargetElement(3) = "Median Home Value"
    Dim i As Integer

    For Each cell In ZipCodeRange
        For i = 1 To 3
            cell.Offset(0, i).Value = dataScrape("th", TargetElement(i), "td")
        Next i
    Next cell
End Sub


Here is the function I'm using to retrieve the data

Private Function dataScrape(ByVal TagName As String, Element As String, targetTagName)

    IE.Open "GET", url &amp; cell.Value, False
    IE.send

    While IE.readyState &lt;&gt; 4: DoEvents: Wend

    Set HTML = New MSHTML.HTMLDocument
    Set HTMLbody = HTML.body
    HTMLbody.innerHTML = IE.responseText

        For Each post In HTMLbody.getElementsByTagName(TagName)
            If InStr(post.innerText, Element) &gt; 0 Then
                dataScrape = post.ParentNode.getElementsByTagName(targetTagName)(0).innerText: Exit For
            End If
        Next post

End Function
"5 min to fetch 70-100 records" seems pretty slow. Even though, you are fetching the same URL 3 times per Zip Code, this still seems slow.  

    For i = 1 To 3
        cell.Offset(0, i).Value = dataScrape("th", TargetElement(i), "td")
    Next i


Avoid using Global variables whenever possible.  Pass the values as parameters instead.

Turning off Application.ScreenUpdating and setting Application.Calculation = xlCalculationManual will speed up the writing the data to the Worksheet.

The code below processed 200 records in 41 seconds.

Refactored Code

Sub ZipCodeScrape()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Const BASE_URL = "https://www.unitedstateszipcodes.org/"
    Dim doc As MSHTML.HTMLDocument, cell As Range

    For Each cell In Range("C2", Range("C2").End(xlDown))
        Set doc = getDocument(BASE_URL &amp; Format(cell.Value, "00000"))
        If Not doc Is Nothing Then
            cell.Offset(0, -2).Value = getPrimaryCity(doc)
            cell.Offset(0, -1).Value = getState(doc)
            cell.Offset(0, 1).Value = getTDByTH(doc, "County: ")
            cell.Offset(0, 2).Value = getTDByTH(doc, "Population")
            cell.Offset(0, 3).Value = getTDByTH(doc, "Median Home Value")
        End If

    Next cell
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Private Function getTDByTH(doc As MSHTML.HTMLDocument, Heading As String) As String
    Dim post As Object
    For Each post In doc.getElementsByTagName("TH")
        If post.innerText = Heading Then
            getTDByTH = post.ParentNode.getElementsByTagName("TD")(0).innerText
            Exit For
        End If
    Next post
End Function

Private Function getPrimaryCity(doc As MSHTML.HTMLDocument) As String
    Dim PrimaryCity As String
    PrimaryCity = getTDByTH(doc, "Primary City:")
    getPrimaryCity = Split(PrimaryCity, ",")(0)
End Function

Private Function getState(doc As MSHTML.HTMLDocument) As String
    Dim PrimaryCity As String
    Dim PrimaryCityArray() As String
    PrimaryCity = getTDByTH(doc, "Primary City:")
    PrimaryCityArray = Split(PrimaryCity, ",")
    getState = Split(PrimaryCityArray(1), " ")(1)
End Function

Private Function getDocument(URL As String) As MSHTML.HTMLDocument
    Dim doc As MSHTML.HTMLDocument
    With New MSXML2.XMLHTTP60
        .Open "GET", URL, False
        .send
        If .readyState = 4 And .Status = 200 Then
            Set doc = New MSHTML.HTMLDocument
            doc.body.innerHTML = .responseText
            Set getDocument = doc
        Else
            Debug.Print "URL Not Responding:  "; URL, "Ready state: "; .readyState, "HTTP request status: "; .Status
        End If
    End With
End Function


The Multi-threaded VBA that you referred to would be considerably faster.