Retrieve data from eBird API and create multi-level hierarchy of locations

Question

As you may know, I like birds. The Cornell Lab of Ornithology has a tool called eBird where you can submit records of the birds you identified. I recently learned they have an API that I can query, yay! Before this I was just hitting pages and parsing source code.

I've never really queried an API before.

Oh and I normally use late binding, but for this you need these (additional) references

• Microsoft HTML Object Library
• Microsoft Internet Controls
• Microsoft WinHTTP Services, version 5.1
• Microsoft Scripting Runtime

---

Code

I have two modules - one to get the data from the API and one to create a hierarchy of that data. I used my Comb Sort Multi-dimensional Array on Key (which can be reviewed there instead of here, if need be).

Module PopulateLocations.bas

Option Explicit

Const DELIMITER As String = "},{"

'| */ Documentation for Regions
'| For this API regionType can be subnational2, subnational1, or country (ISO3166)
'| I will refer to subnational1 as majorRegion and subnational2 as minorRegion /*

Public Sub PopulateEbirdRegions()
    Const minorRegionBaseURL As String = "https://ebird.org/ws2.0/ref/region/list/subnational2/"
    Const majorRegionBaseURL As String = "https://ebird.org/ws2.0/ref/region/list/subnational1/"
    Dim countryArray As Variant
    Dim majorArray As Variant
    Dim minorArray As Variant
    countryArray = RetrieveCountries
    majorArray = GetRegions(majorRegionBaseURL, countryArray, MajorSheet)
    minorArray = GetRegions(minorRegionBaseURL, majorArray, MinorSheet, True)
    
    CreateHierarchy.CreateHierarchy countryArray, majorArray, minorArray
End Sub

Private Function RetrieveCountries() As Variant
    Const COUNTRY_URL As String = "https://ebird.org/ws2.0/ref/region/list/country/world?fmt=csv"
    Dim responseText As String
    Dim response As Variant
    
    responseText = SendHttpRequest(COUNTRY_URL)
    response = Split(responseText, DELIMITER)
    
    Dim countryArray() As String
    ReDim countryArray(LBound(response) To UBound(response), 1 To 2)
    Dim index As Long
    For index = LBound(response) To UBound(response)
        countryArray(index, 1) = ExtractCode(response(index))
        countryArray(index, 2) = ExtractName(response(index))
    Next
    
    countryArray(UBound(countryArray), 2) = Left$(countryArray(UBound(countryArray), 2), Len(countryArray(UBound(countryArray), 2)) - 2)
    
    WriteToSheet countryArray, countrySheet, "Country Code", "Country"
    RetrieveCountries = countryArray
End Function

Private Function GetRegions(ByVal baseRegionURL As String, ByVal sourceArray As Variant, ByVal targetSheet As Worksheet, Optional ByVal isMinor As Boolean = False) As Variant
    Dim fileType As String
    fileType = ".json"

    Dim subNationalValue As String
    Dim responseText As String
    Dim targetURL As String
    Dim index As Long
    index = 1
    Dim resultIndex As Long
    resultIndex = index

    Dim resultArray() As String
    ReDim resultArray(LBound(sourceArray) To UBound(sourceArray), 1 To 2)

    For index = LBound(sourceArray) To UBound(sourceArray)
        subNationalValue = sourceArray(index, 1)
        targetURL = baseRegionURL & subNationalValue & fileType
        responseText = SendHttpRequest(targetURL)
        
        If isMinor Then
            If Not responseText = "[]" Then
                resultArray(resultIndex, 1) = subNationalValue
                resultArray(resultIndex, 2) = responseText
                resultIndex = resultIndex + 1
            End If
        Else
            resultArray(index, 1) = sourceArray(index, 1)
            resultArray(index, 2) = responseText
        End If
    Next
    
    GetRegions = CleanSource(resultArray, targetSheet)
End Function


Private Function CleanSource(ByVal sourceArray As Variant, ByVal targetSheet As Worksheet) As Variant
    Const FIRST_HEADER As String = "Region Code"
    Const SECOND_HEADER As String = "Region Name"
    Dim cleanIndex As Long
    cleanIndex = 1
    Dim index As Long
    Dim sourceIndex As Long
    Dim response As Variant
    Dim cleanArray() As String
    ReDim cleanArray(1 To 10000, 1 To 2) 'I would like to not hard-code this, but it's not variable in itself, but variable across queries

    For sourceIndex = LBound(sourceArray) To UBound(sourceArray)
        If sourceArray(sourceIndex, 2) <> "[]" Then
            response = Split(sourceArray(sourceIndex, 2), DELIMITER)
            For index = LBound(response) To UBound(response)
                cleanArray(cleanIndex, 1) = ExtractCode(response(index))
                cleanArray(cleanIndex, 2) = ExtractName(response(index))
                cleanIndex = cleanIndex + 1
            Next
        End If
    Next
    
    Dim returnArray() As String
    ReDim returnArray(1 To cleanIndex - 1, 1 To 2)
    For index = 1 To UBound(returnArray)
        returnArray(index, 1) = cleanArray(index, 1)
        returnArray(index, 2) = cleanArray(index, 2)
    Next

    WriteToSheet returnArray, targetSheet, FIRST_HEADER, SECOND_HEADER
    CleanSource = returnArray
End Function

Private Function SendHttpRequest(ByVal targetURL As String) As String
    Const API_KEY As String = ""
    Const API_REQUEST_HEADER As String = "X-eBirdApiToken"
    Dim httpRequest As WinHttp.WinHttpRequest
    Set httpRequest = New WinHttp.WinHttpRequest
    httpRequest.Open "GET", targetURL
    httpRequest.setRequestHeader API_REQUEST_HEADER, API_KEY
    httpRequest.send
    SendHttpRequest = httpRequest.responseText
End Function

Private Function ExtractCode(ByVal targetString As String) As String
    ExtractCode = Mid$(targetString, InStr(1, targetString, "code") + 7, InStr((InStr(1, targetString, "code") + 7), targetString, ",") - InStr(1, targetString, "code") - 8)
End Function

Private Function ExtractName(ByVal targetString As String) As String
    ExtractName = Mid$(targetString, InStrRev(targetString, ":") + 2, Len(targetString) - InStrRev(targetString, ":") - 2)
End Function

Private Sub WriteToSheet(ByVal valueArray As Variant, ByVal targetSheet As Worksheet, ByVal firstHeader As String, ByVal secondHeader As String)
    Const FIND_STRING As String = "}"
    targetSheet.Cells(1, 1).Value = firstHeader
    targetSheet.Cells(1, 2).Value = secondHeader
    CombSortArray valueArray, 2
    Dim printRange As Range
    Set printRange = targetSheet.Range(targetSheet.Cells(2, 1), targetSheet.Cells(UBound(valueArray) + 2, 2))
    printRange.Value = valueArray
    printRange.Replace What:=Chr$(34) & FIND_STRING, Replacement:=vbNullString

End Sub

Private Sub CombSortArray(ByRef dataArray As Variant, Optional ByVal numberOfColumns As Long = 1, Optional ByVal sortKeyColumn As Long = 1, Optional ByVal sortAscending As Boolean = True)
    'https://codereview.stackexchange.com/questions/155640/comb-sort-multi-dimensional-array-on-key
    Const SHRINK As Double = 1.3
    Dim initialSize As Long
    initialSize = UBound(dataArray, 1)
    Dim gap As Long
    gap = initialSize
    Dim index As Long
    Dim isSorted As Boolean

    Do While gap > 1 And Not isSorted
        gap = Int(gap / SHRINK)
        If gap > 1 Then
            isSorted = False
        Else
            gap = 1
            isSorted = True
        End If
        index = 1
        Do While index + gap <= initialSize
            If sortAscending Then
                If dataArray(index, sortKeyColumn) > dataArray(index + gap, sortKeyColumn) Then
                    SwapElements dataArray, numberOfColumns, index, index + gap
                    isSorted = False
                End If
            Else
                If dataArray(index, sortKeyColumn) < dataArray(index + gap, sortKeyColumn) Then
                    SwapElements dataArray, numberOfColumns, index, index + gap
                    isSorted = False
                End If
            End If
            index = index + 1
        Loop
    Loop

End Sub
Private Sub SwapElements(ByRef dataArray As Variant, ByVal numberOfColumns As Long, ByVal i As Long, ByVal j As Long)
    Dim temporaryHolder As Variant
    Dim index As Long
    For index = 1 To numberOfColumns
        temporaryHolder = dataArray(i, index)
        dataArray(i, index) = dataArray(j, index)
        dataArray(j, index) = temporaryHolder
    Next
End Sub

Then this module passes the arrays to

Module CreateHierarchy.bas

Option Explicit
Public Sub CreateHierarchy(ByVal countries As Variant, ByVal majorRegions As Variant, ByVal minorRegions As Variant)
    Application.ScreenUpdating = False
    Dim countryIndex As Long
    Dim majorIndex As Long
    Dim minorIndex As Long
    Dim currentRow As Long
    currentRow = 2
    Dim country As String
    Dim region As String
    Dim subRegion As String
    Dim targetSheet As Worksheet
    Set targetSheet = HierarchyTest
    
    minorIndex = 2
    majorIndex = 2

    For countryIndex = LBound(countries) + 1 To UBound(countries)
        If Not IsEmpty(targetSheet.Cells(currentRow, 1)) _
        Or Not IsEmpty(targetSheet.Cells(currentRow, 3)) _
        Or Not IsEmpty(targetSheet.Cells(currentRow, 5)) Then
            currentRow = currentRow + 1
        End If
        
        country = countries(countryIndex, 1)
        targetSheet.Cells(currentRow, 1).Value = country
        targetSheet.Cells(currentRow, 2).Value = countries(countryIndex, 2)
        For majorIndex = majorIndex To UBound(majorRegions)
            region = Left$(majorRegions(majorIndex, 1), 2)

            If StrComp(country, region, vbTextCompare) = 0 Then
                region = majorRegions(majorIndex, 1)
                targetSheet.Cells(currentRow, 3).Value = region
                targetSheet.Cells(currentRow, 4).Value = majorRegions(majorIndex, 2)
                
                For minorIndex = minorIndex To UBound(minorRegions)
                    subRegion = Left$(minorRegions(minorIndex, 1), Len(region))
                    If StrComp(region, subRegion, vbTextCompare) = 0 Then
                        targetSheet.Cells(currentRow, 5).Value = minorRegions(minorIndex, 1)
                        targetSheet.Cells(currentRow, 6).Value = minorRegions(minorIndex, 2)
                        currentRow = currentRow + 1
                    ElseIf StrComp(region, subRegion, vbTextCompare) = -1 Then
                        GoTo skip
                    End If
                Next
            currentRow = currentRow + 1
            ElseIf StrComp(country, region, vbTextCompare) = -1 Then
                GoTo jump
            End If
skip:
        currentRow = currentRow + 1
        Next
jump:

    Next

   Application.ScreenUpdating = True
End Sub

I'm not at all happy with this hierarchy procedure, but it does its job. I'm sure there's a more clever way to do it, but I'm embarrassed about how long it took me to write this junk. If you point out I have three for loops with two ifs in them and make fun of me - I deserve it.

---

Substitute Code

Because I doubt you have an API key, I've made the raw data available and you can alter the Hierarchy module so it doesn't require arguments to execute:

Public Sub CreateHierarchy()
    Application.ScreenUpdating = False

    Dim countries As Variant
    Dim majorRegions As Variant
    Dim minorRegions As Variant
    countries = RetrieveData(countrySheet)
    majorRegions = RetrieveData(MajorSheet)
    minorRegions = RetrieveData(MinorSheet)

...

End Sub

Private Function RetrieveData(ByVal targetSheet As Worksheet) As Variant
    Dim lastRow As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
    Dim dataRange As Range
    Set dataRange = targetSheet.Range(targetSheet.Cells(1, 1), targetSheet.Cells(lastRow, 2))
    RetrieveData = dataRange
End Function

---

Example return text from SendHTTPRequest

This is (some of) the raw data I get and parse, in case there's a better way to do that -

Country

[{"code":"AF","name":"Afghanistan"},{"code":"AL","name":"Albania"},{"code":"DZ","name":"Algeria"},{"code":"AS","name":"American Samoa"},{"code":"AD","name":"Andorra"},{"code":"AO","name":"Angola"},{"code":"AI","name":"Anguilla"},{"code":"AQ","name":"Antarctica"},{"code":"AG","name":"Antigua and Barbuda"},{"code":"AR","name":"Argentina"},{"code":"AM","name":"Armenia"},{"code":"AW","name":"Aruba"},{"code":"AC","name":"Ashmore and Cartier Islands"},{"code":"ZM","name":"Zambia"},{"code":"ZW","name":"Zimbabwe"}]

Major Region

[{"code":"AF-BDS","name":"Badakhshan"},{"code":"AF-BDG","name":"Badghis"},{"code":"AF-BGL","name":"Baghlan"},{"code":"AF-BAL","name":"Balkh"},{"code":"AF-BAM","name":"Bamian"},{"code":"AF-DAY","name":"Daykondi"},{"code":"AF-FRA","name":"Farah"},{"code":"AF-FYB","name":"Faryab"},{"code":"AF-GHA","name":"Ghazni"},{"code":"AF-GHO","name":"Ghowr"},{"code":"AF-HEL","name":"Helmand"},{"code":"AF-HER","name":"Herat"},{"code":"AF-JOW","name":"Jowzjan"},{"code":"AF-KAB","name":"Kabol"},{"code":"AF-KAN","name":"Kandahar"},{"code":"AF-KAP","name":"Kapisa"},{"code":"AF-KHO","name":"Khowst"},{"code":"AF-KNR","name":"Konar"},{"code":"AF-KDZ","name":"Kondoz"},{"code":"AF-LAG","name":"Laghman"},{"code":"AF-LOW","name":"Lowgar"},{"code":"AF-NAN","name":"Nangarhar"},{"code":"AF-NIM","name":"Nimruz"},{"code":"AF-NUR","name":"Nurestan"},{"code":"AF-ORU","name":"Oruzgan"},{"code":"AF-PIA","name":"Paktia"},{"code":"AF-PKA","name":"Paktika"},{"code":"AF-PAN","name":"Panjshir"},{"code":"AF-PAR","name":"Parwan"},{"code":"AF-SAM","name":"Samangan"},{"code":"AF-SAR","name":"Sar-e Pol"},{"code":"AF-TAK","name":"Takhar"},{"code":"AF-WAR","name":"Wardak"},{"code":"AF-ZAB","name":"Zabol"}]

Minor Region

[{"code":"AR-B-AA","name":"Adolfo Alsina"},{"code":"AR-B-AC","name":"Adolfo Gonzales Chaves"},{"code":"AR-B-AL","name":"Alberti"},{"code":"AR-B-AB","name":"Almirante Brown"},{"code":"AR-B-AM","name":"Ameghino"},{"code":"AR-B-BM","name":"Arrecifes"},{"code":"AR-B-AV","name":"Avellaneda"},{"code":"AR-B-AY","name":"Ayacucho"},{"code":"AR-B-AZ","name":"Azul"},{"code":"AR-B-BB","name":"Bahía Blanca"},{"code":"AR-B-BC","name":"Balcarce"},{"code":"AR-B-BD","name":"Baradero"},{"code":"AR-B-BJ","name":"Benito Juárez"},{"code":"AR-B-BZ","name":"Berazategui"},{"code":"AR-B-BS","name":"Berisso"},{"code":"AR-B-BO","name":"Bolívar"},{"code":"AR-B-BG","name":"Bragado"},{"code":"AR-B-BR","name":"Brandsen"},{"code":"AR-B-CM","name":"Campana"},{"code":"AR-B-CS","name":"Capitán Sarmiento"},{"code":"AR-B-CC","name":"Carlos Casares"},{"code":"AR-B-CT","name":"Carlos Tejedor"},{"code":"AR-B-CA","name":"Carmen de Areco"},{"code":"AR-B-CI","name":"Castelli"},{"code":"AR-B-CL","name":"Cañuelas"},{"code":"AR-B-CB","name":"Chacabuco"},{"code":"AR-B-CH","name":"Chascomús"},{"code":"AR-B-CV","name":"Chivilcoy"},{"code":"AR-B-CO","name":"Colón"},{"code":"AR-B-CD","name":"Coronel Dorrego"},{"code":"AR-B-CP","name":"Coronel Pringles"},{"code":"AR-B-CE","name":"Coronel Suárez"},{"code":"AR-B-CR","name":"Coronel de Marina Leonardo Rosales"},{"code":"AR-B-DA","name":"Daireaux"},{"code":"AR-B-DO","name":"Dolores"},{"code":"AR-B-EN","name":"Ensenada"},{"code":"AR-B-ES","name":"Escobar"},{"code":"AR-B-EB","name":"Esteban Echeverría"},{"code":"AR-B-EC","name":"Exaltación de la Cruz"},{"code":"AR-B-FC","name":"Florencio Varela"},{"code":"AR-B-GD","name":"General Alvarado"},{"code":"AR-B-GA","name":"General Alvear"},{"code":"AR-B-GE","name":"General Arenales"},{"code":"AR-B-GB","name":"General Belgrano"},{"code":"AR-B-GG","name":"General Guido"},{"code":"AR-B-GJ","name":"General Juan Madariaga"},{"code":"AR-B-GM","name":"General La Madrid"},{"code":"AR-B-GH","name":"General Las Heras"},{"code":"AR-B-GL","name":"General Lavalle"},{"code":"AR-B-GZ","name":"General Paz"},{"code":"AR-B-GI","name":"General Pinto"},{"code":"AR-B-GP","name":"General Pueyrredón"},{"code":"AR-B-GR","name":"General Rodríguez"},{"code":"AR-B-GN","name":"General San Martín"},{"code":"AR-B-GS","name":"General Sarmiento"},{"code":"AR-B-GT","name":"General Viamonte"},{"code":"AR-B-GV","name":"General Villegas"},{"code":"AR-B-GU","name":"Guaminí"},{"code":"AR-B-HY","name":"Hipólito Yrigoyen"},{"code":"AR-B-JU","name":"Junín"},{"code":"AR-B-LC","name":"La Costa"},{"code":"AR-B-LM","name":"La Matanza"},{"code":"AR-B-LT","name":"La Plata"},{"code":"AR-B-LS","name":"Lanús"},{"code":"AR-B-LR","name":"Laprida"},{"code":"AR-B-LF","name":"Las Flores"},{"code":"AR-B-LA","name":"Leandro N. Alem"},{"code":"AR-B-LI","name":"Lincoln"},{"code":"AR-B-LO","name":"Lobería"},{"code":"AR-B-LB","name":"Lobos"},{"code":"AR-B-LZ","name":"Lomas de Zamora"},{"code":"AR-B-LU","name":"Luján"},{"code":"AR-B-ML","name":"Magdalena"},{"code":"AR-B-MA","name":"Maipú"},{"code":"AR-B-MC","name":"Mar Chiquita"},{"code":"AR-B-MP","name":"Marcos Paz"},{"code":"AR-B-MD","name":"Mercedes"},{"code":"AR-B-ME","name":"Merlo"},{"code":"AR-B-MT","name":"Monte"},{"code":"AR-B-MH","name":"Monte Hermoso"},{"code":"AR-B-MR","name":"Moreno"},{"code":"AR-B-MN","name":"Morón"},{"code":"AR-B-NA","name":"Navarro"},{"code":"AR-B-NE","name":"Necochea"},{"code":"AR-B-NJ","name":"Nueve de Julio"},{"code":"AR-B-OL","name":"Olavarría"},{"code":"AR-B-PA","name":"Patagones"},{"code":"AR-B-PJ","name":"Pehuajó"},{"code":"AR-B-PE","name":"Pellegrini"},{"code":"AR-B-PG","name":"Pergamino"},{"code":"AR-B-PL","name":"Pila"},{"code":"AR-B-PX","name":"Pilar"},{"code":"AR-B-PI","name":"Pinamar"},{"code":"AR-B-PU","name":"Puán"},{"code":"AR-B-QU","name":"Quilmes"},{"code":"AR-B-RM","name":"Ramallo"},{"code":"AR-B-RU","name":"Rauch"},{"code":"AR-B-RI","name":"Rivadavia"},{"code":"AR-B-RO","name":"Rojas"},{"code":"AR-B-RP","name":"Roque Pérez"},{"code":"AR-B-SD","name":"Saavedra"},{"code":"AR-B-SL","name":"Saladillo"},{"code":"AR-B-SQ","name":"Salliqueló"},{"code":"AR-B-ST","name":"Salto"},{"code":"AR-B-SG","name":"San Andrés de Giles"},{"code":"AR-B-SA","name":"San Antonio de Areco"},{"code":"AR-B-SC","name":"San Cayetano"},{"code":"AR-B-SF","name":"San Fernando Partido"},{"code":"AR-B-SI","name":"San Isidro"},{"code":"AR-B-SN","name":"San Nicolás"},{"code":"AR-B-SP","name":"San Pedro"},{"code":"AR-B-SE","name":"San Vicente"},{"code":"AR-B-SU","name":"Suipacha"},{"code":"AR-B-TD","name":"Tandil"},{"code":"AR-B-TP","name":"Tapalqué"},{"code":"AR-B-TI","name":"Tigre"},{"code":"AR-B-TO","name":"Tordillo"},{"code":"AR-B-TQ","name":"Tornquist"},{"code":"AR-B-TR","name":"Trenque Lauquen"},{"code":"AR-B-TA","name":"Tres Arroyos"},{"code":"AR-B-TL","name":"Tres Lomas"},{"code":"AR-B-TF","name":"Tres de Febrero"},{"code":"AR-B-VM","name":"Veinticinco de Mayo"},{"code":"AR-B-VL","name":"Vicente López"},{"code":"AR-B-VG","name":"Villa Gesell"},{"code":"AR-B-VI","name":"Villarino"},{"code":"AR-B-ZA","name":"Zárate"}]

Answer 1

The OP has got the web scraping very close. But there are a couple of things that need to be tweaked.

WriteToSheet:Sub

Case in point WriteToSheet. RetrieveCountries pass a Base 0 array to it and CleanSource passes a Base 1 array. There seems to be no attempt to adjust for the differences. It is causing the target ranges for both and to be 1 row larger then the data array. This is causing the #N/A in the last row of both the MinorSheet and the MajorSheet.

The cells should also be cleared before the data in added.

Here is an easy fix:

Set printRange = targetSheet.Range("A2").Resize(UBound(valueArray) - LBound(valueArray) + 1, 2)

This line tells me that the technique for parsing the JSON is incomplete:

printRange.Replace What:=Chr$(34) & FIND_STRING, Replacement:=vbNullString

RetrieveCountries:Function

Here is another attempt to jerry-rig the code because the parsing isn't quite right.

countryArray(UBound(countryArray), 2) = Left$(countryArray(UBound(countryArray), 2), Len(countryArray(UBound(countryArray), 2)) - 2)

Adjusting the last element in an array after the value has been assigned to it, feels ... I don't know tacky??

I would probably strinp the ends of the responseText first.

 responseText = Mid(responseText,4,len(responseText)-6)

---

IMO. writing a Function to process the JSON responseText and a Sub to merge arrays would greatly simplify the code.

Function JSONCodeNameToArray(responseText As String)  as Variant()

Sub MergeJSONArrays(Arr1 as Variant(), Arr2 As Variant())

I think that it would be even easier to pass a Dictionary with the responseText. This would make adding the "Sub Regions" really simple.

Sub AddJSON(ByRef responseText As String, ByRef Dic As Object)

---

Addendum

CreateHierarchy:Class

I am not going to examine this class but instead am going to show an easier way to create the hierarchy using sequel. To simplify writing the SQL I pasted the worksheets from ebird.xlsm into an Access database. I then used the query designer to write and test the sql. The query can also be modify to ran against ebird.xlsm. You will have to enclose the worksheet names followed by $ in brackets(e.g [SubNat2Sheet$] .

SELECT countrySheet.[Country Code], countrySheet.Country, SubNat1Sheet.[Region Code], SubNat1Sheet.[Region Name]
FROM countrySheet INNER JOIN SubNat1Sheet ON countrySheet.[Country Code] = Left(SubNat1Sheet.[Region Code],2)
UNION ALL
SELECT countrySheet.[Country Code], countrySheet.Country, SubNat2Sheet.[Region Code], SubNat2Sheet.[Region Name]
FROM countrySheet INNER JOIN SubNat2Sheet ON countrySheet.[Country Code] = Left(SubNat2Sheet.[Region Code],2)

Answer 2

My first answer was a review of the OP's post. This answer is an alternate approach.

The my first solution and OP's approach took about 775 seconds to make 3936 synchronized WinHttp.WinHttpRequest requests. Using asynchronous MSXML2.ServerXMLHTTP requests with a callback class completes the same 3936 requests to 16 seconds.

UpdateRegions:Sub

Public Sub UpdateRegions()
    Dim StartTime As Long: StartTime = Timer
    Dim Target As Range
    Dim Controller As EBirdController
    Set Controller = New EBirdController
    Controller.Initialize

    While Not Controller.ReadyStateComplete
        DoEvents
    Wend

    With Worksheets("Results")
        .Cells.Clear
        With .Range("A1").Resize(1, 6)
            .Value = Array("Contry Code", "Country", "Region Code", "Region", "Sub Region Code", "Sub Region")
            .Font.Bold = True
            .Interior.Color = 6299648
            .Font.ThemeColor = xlThemeColorDark1
        End With
        Set Target = Controller.CopyToRange(.Range("A2"))

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Target.Columns("B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Target.Columns("D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Target.Columns("F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Target.Resize(Target.Rows.Count + 1).Offset(-1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Columns.AutoFit
    End With
    MsgBox "Run Time in Seconds: " & Round(Timer - StartTime, 2)
End Sub

EBirdController:Class

Option Explicit
Private Const COUNTRY_URL As String = "https://ebird.org/ws2.0/ref/region/list/country/world.csv"
Private Const REGION_BASE_URL As String = "https://ebird.org/ws2.0/ref/region/list/subnational"
Private Const MAX_CONNECTIONS As Long = 50
Private Type Members
    CompletedRequestsList As Object
    OpenRequestsList As Object
    RequestStack As Object
End Type
Private m As Members

Private Enum DataFields
    dfCode = 1
    dfName
End Enum

Private Sub Class_Initialize()
    Set m.CompletedRequestsList = CreateObject("System.Collections.ArrayList")
    Set m.OpenRequestsList = CreateObject("System.Collections.ArrayList")
    Set m.RequestStack = CreateObject("System.Collections.Stack")
End Sub

Private Function getRequestData(Request As EBirdRegionalRequest) As String()
    Dim values() As String, results() As String
    Dim index As Long, r As Long
    values = Split(Request.getResponseText, Chr(10))

    If UBound(values) > 1 Then ReDim results(1 To UBound(values) - 1, 1 To 2) Else ReDim results(0 To 0, 1 To 2)
    For r = 1 To UBound(values) - 1
        index = InStr(values(r), ",")
        results(r, dfCode) = Left(values(r), index - 1)
        results(r, dfName) = Right(values(r), Len(values(r)) - index)
    Next

    getRequestData = results
End Function

Public Sub Initialize()
    AddRequest COUNTRY_URL
    ProcessRequestStack
End Sub

Public Sub ReadyStateChangeHandler(Request As EBirdRegionalRequest)
    Dim data() As String
    Dim index As Long, r As Long
    Dim URL As String
    m.OpenRequestsList.Remove Request.URL
    data = getRequestData(Request)

    If UBound(data) = 0 Then  'And Request.URL Like REGION_BASE_URL & "2\*"
        m.CompletedRequestsList.Add Array(Request.countryCode, Request.country, Request.regionCode, Request.region, data(r, dfCode), data(r, dfName))
    Else
        For r = 1 To UBound(data)
            If Request.URL = COUNTRY_URL Then
                URL = REGION_BASE_URL & "1/" & data(r, dfCode) & ".csv"
                AddRequest URL, data(r, dfCode), data(r, dfName)
            ElseIf Request.URL Like REGION_BASE_URL & "1/*" Then
                URL = REGION_BASE_URL & "2/" & data(r, dfCode) & ".csv"
                AddRequest URL, Request.countryCode, Request.country, data(r, dfCode), data(r, dfName)
            Else
                m.CompletedRequestsList.Add Array(Request.countryCode, Request.country, Request.regionCode, Request.region, data(r, dfCode), data(r, dfName))
            End If
        Next
    End If
    Set Request = Nothing
    ProcessRequestStack
End Sub

Private Sub AddRequest(URL As String, Optional countryCode As String, Optional country As String, Optional regionCode As String, Optional region As String)
    Dim Request As New EBirdRegionalRequest
    With Request
        .URL = URL
        .countryCode = countryCode
        .country = country
        .regionCode = regionCode
        .region = region
    End With
    m.RequestStack.Push Request
End Sub

Private Sub ProcessRequestStack()
    Dim Request As EBirdRegionalRequest
    If m.OpenRequestsList.Count = MAX_CONNECTIONS Then Stop
    Do Until m.OpenRequestsList.Count = MAX_CONNECTIONS Or m.RequestStack.Count = 0
        Set Request = m.RequestStack.Pop
        m.OpenRequestsList.Add Request.URL
        Request.setCallback Me
    Loop
End Sub

Public Function CopyToRange(Target As Range) As Range
    Dim results() As Variant
    If m.CompletedRequestsList.Count > 0 Then
        results = m.CompletedRequestsList.ToArray
        results = Application.Transpose(results)
        results = Application.Transpose(results)
        Set Target = Target.Resize(UBound(results), UBound(results, 2))
        Target.Value = results
    End If
    Set CopyToRange = Target
End Function

Public Property Get ReadyStateComplete() As Boolean
    ReadyStateComplete = m.OpenRequestsList.Count = 0 And m.RequestStack.Count = 0
End Property

EBirdRegionalRequest:Class

Option Explicit
Private Const API_KEY As String = "Sign up and get your own key..lol"
Private Const API_REQUEST_HEADER As String = "X-eBirdApiToken"
Private Type Members
    Controller As EBirdController
    responseText As String
    XMLHttpReq As Object
End Type
Private m As Members

Public country As String
Public countryCode As String
Public region As String
Public regionCode As String
Public subRegion As String
Public subregionCode As String
Public URL As String

Function getResponseText() As String
    getResponseText = m.XMLHttpReq.responseText
End Function

Public Sub ReadyStateChangeHandler()
Attribute ReadyStateChangeHandler.VB_UserMemId = 0
    If m.XMLHttpReq.readyState = 4 Then
        m.Controller.ReadyStateChangeHandler Me
    End If
End Sub

Public Sub setCallback(Controller As EBirdController)
    Set m.Controller = Controller
    Set m.XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
    With m.XMLHttpReq
        .onreadystatechange = Me
        .Open "GET", URL, True
        .setRequestHeader API_REQUEST_HEADER, API_KEY
        .Send
    End With
End Sub

References

http://www.tushar-mehta.com/publish_train/xl_vba_cases/vba_web_pages_services/#_Toc173749363 https://msdn.microsoft.com/en-us/library/ms757030.aspx http://dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/ https://github.com/driverdan/node-XMLHttpRequest/blob/master/lib/XMLHttpRequest.js#L358 https://codingislove.com/http-requests-excel-vba/

Max Connections

There is no noticeable difference between having 50 or 100 open connections at one time. Increasing MAX_CONNECTIONS to 250 causes the code not to complete. For some reason this increases the callback time and causes a number of requests not to be returned to the Controller.

Edits

I update the code to late binding. This is no longer a need for any "External Library References".