FCC Census Block API

The Census Block Conversions API from FCC.gov lets you look up census block numbers based on latitude/longitude pairs.

From FCC.gov:

This API returns the US Census Bureau Census Block number (aka the 15 character FIPS Code) given a passed Latitude and Longitude. The API also returns the US State and County name associated with the Block.

Let's review how we can query this API in our VBA programs.

First I define a constant that represents the API query URL:

Public Const baseURL As String = _
    "http://data.fcc.gov/api/block/find?latitude=40.0&longitude=-85"

Instead of removing the latitude and longitude from the example URL, we'll use the Replace function to swap out the example values with the values passed to the function.

The GetFIPSCode Function

The following function will query the API for the FIPS code, then cache the response.

You will need a latitude/longitude pair to call the function. To return latitude and/or longitude for a given point in the United States, see Latitude and Longitude Functions.

Note that this custom function may not return all available information from the API, and is provided here for reference only. For example, the API may have additional fields that are not returned by the function, or additional query parameters with which to filter the results of the query.

Function GetFIPSCode(latitude As String, longitude As String, _
                     Optional forceRequery As Boolean = False) As String

Dim xml As Object  ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim xmlDoc As Object  ' MSXML2.DOMDocument
Dim xmlDocRoot As Object  ' MSXML2.IXMLDOMNode
Dim block As Object  ' MSXML2.IXMLDOMNode
Dim responseCode As String
Dim i As Long, j As Long

Const XML_FILE_EXTENSION As String = ".xml"

  tempFolder = environ("temp") & "\"
  tempFile = tempFolder & "FCC_fipscode" & latitude & longitude & XML_FILE_EXTENSION

  ' requery if cache file is missing or forceRequery set to True
  If Len(Dir(tempFile)) = 0 Or forceRequery Then

    Set xml = GetMSXML

    With xml
      .Open "GET", Replace(Replace(baseURL, "-85", longitude), "40.0", latitude), False
      .send
    End With

    result = xml.responseText

    CreateFile tempFile, ConvertAccent(result)

  End If

  ' load XML file into new XML document
  Set xmlDoc = GetDomDoc

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
  If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
  Set xmlDocRoot = GetRootNode(xmlDoc)

  ' check for error code
  responseCode = xmlDocRoot.Attributes.getNamedItem("status").nodeTypedValue

  If responseCode <> "OK" Then
    Exit Function
  End If

  Set block = GetNode(xmlDocRoot, 1)
  GetFIPSCode = block.Attributes.getNamedItem("FIPS").nodeTypedValue

End Function

The Replace Function is used to take out the latitude and longitude from the constant URL and replace them with the ones passed to the function. It's a bit easier than having to put together a URL that is part variable and part String literals.

Helper Functions

The MSXML helper functions should also be included in the same project.

Sample Usage

Sub TestGetFIPSCode()

Dim result As String

  result = GetFIPSCode("40.0", "-85")
  Debug.Print result

End Sub