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 if
s 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"}]
vba
person, so no review, sorry. \$\endgroup\$Regions
withoutSub Regions
. It returns 9298 records in under 17 seconds. This seems comparable toWorksheets("HierarchyTest")
but it is hard to say because your data extends 9685 but has blank rows. \$\endgroup\$