• 1

• 7.3k
• 1
• 23
• 60

• 7.3k
• 1
• 23
• 60

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.

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