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"}]

• vnp: Thanks for sharing, for I have an account there. I didn't know about an API. Definitely will give it a try. Unfortunately I am not a vba person, so no review, sorry.
• TinMan: I just modifies my 2nd answer to include Regions without Sub Regions. It returns 9298 records in under 17 seconds. This seems comparable to Worksheets("HierarchyTest") but it is hard to say because your data extends 9685 but has blank rows.
• Malte Susen: Looks like a very interesting approach, thanks for sharing. Given the multitude of updates and edits: is there any "plain vanilla" summary for your code to handle multiple requests at a time? A lean overview with the essential code would be highly appreciated.
• Raystafarian: @M.S. It's all right here - github.com/RaymondWise/eBird_API_VBA but no, there is no multi-threaded approach and I'm not entirely sure this is a very effective way to do this, as you can see it hasn't been updated since June, but feel free to clone the repo if you'd like. Or check out the second answer below.

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)

EBird Hierarchy Demo

• TinMan: @Raystafarian Thanks. I updated my answer to show how to create the hierarchy using sql.
• TinMan: @Raystafarian I went ahead signed up and got an API Key. The csv format really simplifies the code. Here is my test code: Ebird Hierarchy.txt. I think that it will help you as you develop your project. Thanks for sharing the API and your code.
• Raystafarian: That's excellent of you - thanks! The next stage is pulling data again but making charts with it.
• Raystafarian: Incredible improvement - 62 seconds. Incredible.
• TinMan: @Raystafarian thanks. The performance gain comes from only making a 2nd http request when needed. If you change the field data types to adVarChar and specify the field size (e.g. .Append COUNTRYNAME, adVarChar, 50), you will be able to sort the recordset. I would .UpdateBatch, .Sort and then .Movefirst. Example: .Sort = "[" & COUNTRYNAME & "] ASC, [" & REGIONCODE & "]"

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.

Results Image

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".

• Raystafarian: A second answer that's faster? I will try this, thank you. I've never worked "Async" before
• TinMan: @Raystafarian RegoinRS As EbirdReginalRequest is legacy code please remove that line. I had issues with the recordset accepting some characters so I converted it to an array. I update my answer.
• TinMan: Here is a download link: EBird Asnc.xlsm. You'll need to add your API key.
• TinMan: Sorry, that code is not needed ethier. I added that to try and figure out why having too many open connections prevents the code from completing.
• Raystafarian: That was the only thing different - I wonder why my copies didn't work. Either way this is superb!