Species Dictionary

This page will contain useful functions for managing species dictionary

---

Match taxonversionkeys in ACCESS

This VBA matches taxonversionkeys from the NHM nameserver. Need to include taxon names in taxon field of dataset table and link nameserver of species dictionary as TaxonDictionary

Dim db As Database
Dim tbl As TableDef
Dim rec As Recordset
Dim fld As Field
Dim strSql As String
Dim qry As QueryDef
Dim blVariable As Boolean
Dim iTaxa As Long
Dim arrTaxa As Variant
Public Sub Match_Taxa()

'SET CURRENT DB
Set db = CurrentDb
'SysCmd acSysCmdSetStatus, ""

'ADD TAXONVERSIONKEY FIELD IF NOT PRESENT
blVariable = False
Set tbl = db.TableDefs("Dataset")
For Each fld In tbl.Fields
  If fld.Name = "TaxonVersionKey" Then
    blVariable = True
  End If
Next

If blVariable = False Then
  Set fld = tbl.CreateField("TaxonVersionKey", dbText)
  With fld
    .Size = 255
  End With
  tbl.Fields.Append fld
  tbl.Fields.Refresh
End If
blVariable = False

'CREATE TAXON MATCHING TABLE
On Error Resume Next
db.QueryDefs.Delete ("tempMatchTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchTaxa1")
strSql = "SELECT Dataset.Taxon, Dataset.Taxon AS Taxon_Modified, Dataset.TaxonVersionKey, 0 AS Matched, TaxonDictionary.INFORMAL_GROUP AS TaxonGroup FROM Dataset "
strSql = strSql & "INNER JOIN TaxonDictionary ON Dataset.Taxon = TaxonDictionary.TAXON_NAME "
strSql = strSql & "GROUP BY Dataset.Taxon, Dataset.Taxon, Dataset.TaxonVersionKey, 0, TaxonDictionary.INFORMAL_GROUP;"
qry.SQL = strSql

On Error Resume Next
db.TableDefs.Delete ("TaxonMatching")
db.QueryDefs.Delete ("tempMatchTaxa2")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchTaxa2")
strSql = "SELECT tempMatchTaxa1.Taxon, tempMatchTaxa1.Taxon_Modified, tempMatchTaxa1.TaxonVersionKey, tempMatchTaxa1.Matched, Count(tempMatchTaxa1.TaxonGroup) AS TaxonGroup INTO TaxonMatching FROM tempMatchTaxa1 "
strSql = strSql & "GROUP BY tempMatchTaxa1.Taxon, tempMatchTaxa1.Taxon_Modified, tempMatchTaxa1.TaxonVersionKey, tempMatchTaxa1.Matched;"
qry.SQL = strSql
qry.Execute
On Error Resume Next
db.QueryDefs.Delete ("tempMatchTaxa1")
db.QueryDefs.Delete ("tempMatchTaxa2")
On Error GoTo 0

'RULE OUT TAXON MATCHING WHERE TAXON OCCURS ACROSS TAXON GROUPS
On Error Resume Next
db.QueryDefs.Delete ("tempMatchTaxaATG")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchTaxaATG")
strSql = "UPDATE TaxonMatching SET TaxonMatching.Taxon_Modified = 'AcrossTaxonGroups' "
strSql = strSql & "WHERE (((TaxonMatching.TaxonGroup)>1));"
qry.SQL = strSql
qry.Execute
On Error Resume Next
db.QueryDefs.Delete ("tempMatchTaxaATG")
On Error GoTo 0

'RUN MAIN TAXON MATCHING QUERIES
Call SpeciesMatchingQueries

'RUN ADDITIONAL TAXON MATCHING QUERIES
'Call AdditionalSpeciesMatchingQueries

Set rec = db.OpenRecordset("TaxonMatching")
iTaxa = rec.RecordCount

'MODIFY NAMES AN RERUN MATCHING QUERIES
If iTaxa <> 0 Then
  'MODIFY TAXON NAMES
  Call ModifyTaxonName
  Call SpeciesMatchingQueries
  'Call AdditionalSpeciesMatchingQueries

  On Error Resume Next
  db.QueryDefs.Delete ("tempTaxonMatching")
  On Error GoTo 0
  Set qry = db.CreateQueryDef("tempTaxonMatching")
  strSql = "UPDATE TaxonMatching SET TaxonMatching.Taxon_Modified = [TaxonMatching]![Taxon];"
  qry.SQL = strSql
  qry.Execute
  On Error Resume Next
  db.QueryDefs.Delete ("tempTaxonMatching")
  On Error GoTo 0

End If

'RECOUNT TAXONMATCHING TABLE
iTaxa = rec.RecordCount

'DELETE TAXONMATCHING TABLE IF EMPTY
If iTaxa = 0 Then
 On Error Resume Next
  db.TableDefs.Delete ("TaxonMatching")
 On Error GoTo 0
 db.TableDefs.Refresh
End If

'DISPLAY END MESSAGE
SysCmd acSysCmdSetStatus, "Matching finished: " & iTaxa & " taxa remaining"

rec.Close

End Sub

Public Sub ModifyTaxonName()

'MODIFICATION 1: ADD SUBSP. TO TRINOMIAL
If iTaxa <> 0 Then
  With rec
    .MoveFirst
    Do Until .EOF
      arrTaxa = Split(rec("Taxon"), " ", -1, vbTextCompare)
      If UBound(arrTaxa) = 2 Then
        .Edit
        rec("Taxon_modified") = arrTaxa(0) & " " & arrTaxa(1) & " " & "subsp. " & arrTaxa(2)
        .Update
      End If
      .MoveNext
    Loop
   End With
End If

End Sub

Public Sub SpeciesMatchingQueries()

'SPECIES MATCHING QUERIES - THESE MATCHES SHOULD PRODUCE THE OPTIMAL TAXON MATCHING

'FIRST ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0));"
qry.SQL = strSql

Call FindUniqueMatches

'SECOND ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_FORM IS WELL FORMED
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_FORM)='W'));"
qry.SQL = strSql

Call FindUniqueMatches

'THIRD ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_STATUS IS RECOMMENDED
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_STATUS)='R'));"
qry.SQL = strSql

Call FindUniqueMatches

'FOURTH ROUND: GET TAXA WHERE UNIQUE TAXONVERSIONKEY EQUALS UNIQUE RECOMMENDED TAXONVERSIONKEY
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((IIf([TaxonDictionary]![NBN_TAXON_VERSION_KEY_FOR_RECOMMENDED_NAME]=[TaxonDictionary]![NBN_TAXON_VERSION_KEY],'T','F'))='T'));"
qry.SQL = strSql

Call FindUniqueMatches

'FIFTH ROUND: GET TAXA WHERE RANK OF UNIQUE TAXONVERSIONKEY EQUALS RANK OF RECOMMENDED TAXONVERSIONKEY
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaR")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxaR")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.RECOMMENDED_NAME_RANK AS Rank FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "GROUP BY TaxonMatching.Taxon_Modified, TaxonDictionary.RECOMMENDED_NAME_RANK;"
qry.SQL = strSql

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT tempMatchingTaxaR.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM tempMatchingTaxaR "
strSql = strSql & "INNER JOIN TaxonDictionary ON (tempMatchingTaxaR.Rank = TaxonDictionary.RANK) AND (tempMatchingTaxaR.Taxon_Modified = TaxonDictionary.TAXON_NAME);"
qry.SQL = strSql

Call FindUniqueMatches

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaR")
On Error GoTo 0

End Sub

Public Sub AdditionalSpeciesMatchingQueries()

'ADDITIONAL MATCHES - THESE MATCHES MAY NOT PRODUCE THE OPTIMAL TAXON MATCHING

'SIXTH ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_FORM IS INCORRECT
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_FORM)='I'));"
qry.SQL = strSql

Call FindUniqueMatches

'SEVENTH: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_STATUS IS SYNONYMOUS
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_STATUS)='S'));"
qry.SQL = strSql

Call FindUniqueMatches

'EIGHTH ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_FORM IS UNVERIFIED
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_FORM)='U'));"
qry.SQL = strSql

Call FindUniqueMatches

'NINETH ROUND: GET TAXA WITH UNIQUE TAXONVERSIONKEY WHERE NAME_STATUS IS UNVERIFIED
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT TaxonMatching.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=0) AND ((TaxonDictionary.NAME_STATUS)='U'));"
qry.SQL = strSql

Call FindUniqueMatches

'TENTH ROUND: GET TAXA WHERE UNIQUE TAXONVERSIONKEY HAS MAX LATEST CHANGE
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaLC")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxaLC")
strSql = "SELECT TaxonMatching.Taxon_Modified, Max(TaxonDictionary.DATE_RECORD_LAST_CHANGED) AS LatestChanged FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "GROUP BY TaxonMatching.Taxon_Modified;"
qry.SQL = strSql

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT tempMatchingTaxaLC.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM tempMatchingTaxaLC "
strSql = strSql & "INNER JOIN TaxonDictionary ON (tempMatchingTaxaLC.LatestChanged = TaxonDictionary.DATE_RECORD_LAST_CHANGED) AND (tempMatchingTaxaLC.Taxon_Modified = TaxonDictionary.TAXON_NAME);"
qry.SQL = strSql

Call FindUniqueMatches

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaLC")
On Error GoTo 0

'ELEVENTH ROUND: GET TAXA WHERE UNIQUE TAXONVERSIONKEY HAS MAX DATE ADDED
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaLA")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxaLA")
strSql = "SELECT TaxonMatching.Taxon_Modified, Max(TaxonDictionary.DATE_RECORD_ADDED) AS LatestAdded FROM TaxonMatching "
strSql = strSql & "INNER JOIN TaxonDictionary ON TaxonMatching.Taxon_Modified = TaxonDictionary.TAXON_NAME "
strSql = strSql & "GROUP BY TaxonMatching.Taxon_Modified;"
qry.SQL = strSql

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa1")
strSql = "SELECT tempMatchingTaxaLA.Taxon_Modified, TaxonDictionary.NBN_TAXON_VERSION_KEY AS TaxonVersionKey, 1 AS Matches FROM tempMatchingTaxaLA "
strSql = strSql & "INNER JOIN TaxonDictionary ON (tempMatchingTaxaLA.LatestAdded = TaxonDictionary.DATE_RECORD_ADDED) AND (tempMatchingTaxaLA.Taxon_Modified = TaxonDictionary.TAXON_NAME);"
qry.SQL = strSql

Call FindUniqueMatches

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxaLA")
On Error GoTo 0

End Sub

Public Sub FindUniqueMatches()

'CREATE TEMPTAXAMATCHING TABLE WITH UNIQUE MATCHES
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa2")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa2")
strSql = "SELECT tempMatchingTaxa1.Taxon_Modified FROM tempMatchingTaxa1 "
strSql = strSql & "GROUP BY tempMatchingTaxa1.Taxon_Modified "
strSql = strSql & "HAVING (((Sum(tempMatchingTaxa1.Matches))=1));"
qry.SQL = strSql

On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa3")
db.TableDefs.Delete ("tempTaxonMatching")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa3")
strSql = "SELECT tempMatchingTaxa1.Taxon_Modified, tempMatchingTaxa1.TaxonVersionKey INTO tempTaxonMatching FROM tempMatchingTaxa2 "
strSql = strSql & "INNER JOIN tempMatchingTaxa1 ON tempMatchingTaxa2.Taxon_Modified = tempMatchingTaxa1.Taxon_Modified;"
qry.SQL = strSql
qry.Execute
db.TableDefs.Refresh

'UPDATE TAXOMMATCHING TABLE WITH UNIQUE MATCHES
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa4")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa4")
strSql = "UPDATE tempTaxonMatching INNER JOIN TaxonMatching ON tempTaxonMatching.Taxon_Modified = TaxonMatching.Taxon_Modified "
strSql = strSql & " SET TaxonMatching.TaxonVersionKey = [tempTaxonMatching]![TaxonVersionKey], TaxonMatching.Matched = 1;"
qry.SQL = strSql
qry.Execute

'TIDY UP TABLES AND QUERIES
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa1")
db.QueryDefs.Delete ("tempMatchingTaxa2")
db.QueryDefs.Delete ("tempMatchingTaxa3")
db.QueryDefs.Delete ("tempMatchingTaxa4")
db.TableDefs.Delete ("tempTaxonMatching")
On Error GoTo 0

'UPDATE DATASET TABLE WITH UNIQUE MATCHES
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa5")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa5")
strSql = "UPDATE TaxonMatching INNER JOIN Dataset ON TaxonMatching.Taxon = Dataset.Taxon "
strSql = strSql & "SET Dataset.TaxonVersionKey = [TaxonMatching]![TaxonVersionKey] "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=1));"
qry.SQL = strSql
qry.Execute
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa5")
On Error GoTo 0

'DELETE UNIQUE MATCHES FROM TAXOMMATCHING TABLE
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa6")
On Error GoTo 0
Set qry = db.CreateQueryDef("tempMatchingTaxa6")
strSql = "DELETE DISTINCTROW TaxonMatching.*, TaxonMatching.Matched FROM TaxonMatching "
strSql = strSql & "WHERE (((TaxonMatching.Matched)=1));"
qry.SQL = strSql
qry.Execute
On Error Resume Next
db.QueryDefs.Delete ("tempMatchingTaxa6")
On Error GoTo 0

End Sub

---

Match taxonversionkeys to EXCEL list

This function matches taxonversionkey to a taxon list using named range in Microsoft Excel

Named Range
TaxonName, TaxonVersionKey columns in specieslist worksheet
=OFFSET(specieslist!$A$2,0,0,COUNTA(specieslist!$A:$A)-1,2)

'GETS TAXONVERSIONKEY USING VLOOKUP FUNCTION FROM NAMED RANGE "SPECIESLIST"
Public Function NBN_Get_TaxonVersionKey(taxonname As String) As String

Dim tvk As String
tvk = ""

On Error Resume Next
tvk = WorksheetFunction.VLookup(taxonname, ThisWorkbook.Sheets("specieslist").Range("specieslist"), 2, False)
On Error GoTo 0

NBN_Get_TaxonVersionKey = tvk

End Function