Great Circle Distance - JP Software Technologies

Great Circle Distance UDF using Yahoo API and XML

Yahoo provides a nifty geocoding API which we can use to return latitude and longitude information, based on a given street address. Here I will show a simple UDF that uses XML to return this data to two string variables, which can be used in other VBA procedures or directly in the worksheet.

I have previously posted some sample code showing how to get driving distance into Excel, namely

Website Parsing/Retrieval using XML
The GetDistance function.

The first thing I did was go to the following website and create a Yahoo API: Yahoo Developer Network and the website that explains how it works is here: Yahoo Geocoding API

To construct the URL, I simply used the sample URL from their site (see below) and replaced the appid with the one I created using the link above. When you create your own appid, it should be placed in the URL below, between "appid=" and "&street". Then we can use function arguments to pass the additional parameters (city, state and zip).

http://local.yahooapis.com/MapsService/V1/geocode?appid=sGmf70bV34H6QgDaDk.tLer1VOJZEf.P7nZPi2V8MMmFDEQ_f30ByzwxgTI-&street=701+First+Ave&city=Sunnyvale&state=CA

Then it is simply a matter of using the stock code from Website Parsing/Retrieval using XML and using text functions like Instr, Left$, Mid$ and Len to extract the latitude and longitude from the returned XML response.

Requires Microsoft XML, v6.0 (c:\WINDOWS\system32\msxml6.dll on my system).

Function GCDist(strStartAddr As String, strStartCity As String, _
strStartState As String, strEndAddr As String, strEndCity As String, _
strEndState As String) As Double
'
' Jimmy Pena 4-2-2008
' http://www.jpsoftwaretech.com
'
' uses formula from http://www.cpearson.com/excel/latlong.htm with slight mod

Dim MyStartLat As String
Dim MyStartLong As String
Dim MyEndLat As String
Dim MyEndLong As String

MyStartLat = GetLatitude(strStartAddr, strStartCity, strStartState)
MyStartLat = CDec(MyStartLat)
MyStartLong = GetLongitude(strStartAddr, strStartCity, strStartState)
MyStartLong = CDec(MyStartLong)

MyEndLat = GetLatitude(strEndAddr, strEndCity, strEndState)
MyEndLat = CDec(MyEndLat)
MyEndLong = GetLongitude(strEndAddr, strEndCity, strEndState)
MyEndLong = CDec(MyEndLong)

With WorksheetFunction
    GCDist = Format(3958.756 * .Acos(Cos(.Radians(90 - (MyStartLat))) * _
Cos(.Radians(90 - (MyEndLat))) + Sin(.Radians(90 - (MyStartLat))) * _
Sin(.Radians(90 - (MyEndLat))) * _
Cos(.Radians((MyStartLong - MyEndLong)))), "####.##")
End With

End Function

Private Function GetLatitude(strStreet As String, strCity As String, _
strState As String) As String

Dim sURL As String
Dim FirstPos As Long
Dim LastPos As Long
Dim xmlSite As Object ' MSXML2.XMLHTTP60

Set xmlSite = GetMSXML

sURL = "http://local.yahooapis.com/MapsService/V1/geocode?" & _
"appid=sGmf70bV34H6QgDaDk.tLer1VOJZEf.P7nZPi2V8MMmFDEQ_f30ByzwxgTI-" & _
"&street=" & Replace(strStreet, " ", "+") & "&city=" & strCity & _
"&state=" & strState

xmlSite.Open "GET", sURL, False
xmlSite.Send

Do Until xmlSite.readyState = 4
Loop

FirstPos = InStr(xmlSite.responseText, "Latitude") + 9
LastPos = InStr(FirstPos + 1, xmlSite.responseText, "/Latitude") - 1

GetLatitude = Mid$(xmlSite.responseText, FirstPos, LastPos - FirstPos)

Set xmlSite = Nothing

End Function

Private Function GetLongitude(strStreet As String, strCity As String, _
strState As String) As String

Dim sURL As String
Dim FirstPos As Long
Dim LastPos As Long
Dim xmlSite As Object ' MSXML2.XMLHTTP60

Set xmlSite = GetMSXML

sURL = "http://local.yahooapis.com/MapsService/V1/geocode?" & _
"appid=sGmf70bV34H6QgDaDk.tLer1VOJZEf.P7nZPi2V8MMmFDEQ_f30ByzwxgTI-" & _
"&street=" & Replace(strStreet, " ", "+") & "&city=" & strCity & _
"&state=" & strState

xmlSite.Open "GET", sURL, False
xmlSite.Send

Do Until xmlSite.readyState = 4
Loop

FirstPos = InStr(xmlSite.responseText, "Longitude") + 10
LastPos = InStr(FirstPos + 1, xmlSite.responseText, "/Longitude") - 1

GetLongitude = Mid$(xmlSite.responseText, FirstPos, LastPos - FirstPos)

Set xmlSite = Nothing

End Function

To use, you should have a starting address, city and state in separate cells (ex: A1:A3), and destination address, city and state in separate cells (ex: B1:B3) type =GCDist(A1,A2,A3,B1,B2,B3) in a cell and press Enter. You could also type the arguments directly into the parenthesis, for example:

=GCDist("123 Main St","Queens","NY","100 Main Blvd","Ames","IA")

The first thing you may notice is just how much faster this is than the GetDistance() function above. Keep in mind, though, that even though it is much faster, less volatile and less prone to error, this function returns great circle ("as the crow flies") distances, where the GetDistance() function returns actual door to door distance (much more useful in my opinion).

The first thing the function does is pass the arguments to the "real" functions, a series of functions declared Private so they are only accessible from the GCDist() function. i.e. they can't be found in the GUI. These functions, GetLatitude() and GetLongitude(), use the XMLHTTP60 object to open a request to the Yahoo website, pass the URL and grab the return text, then parse it for the latitute and longitude (respectively).

These values are returned to the GCDist function, converted to decimal values (CDec), then passed to the formula (courtesy of Chip Pearson's website) which calculates the great circle distance.

I use the Replace() function because if you notice in the sample URL there are plus signs where there are usually spaces in the street address. Since we can't have spaces in the URL, we replace them with plus signs wherever found.

Geocoder Distance Calculation

Geocoder lists a Javascript function to calculate great circle distance between two points in miles. I have converted it to VB here. I'm not sure how accurate it is, however, but the results were consistent with the other Geocoder functions. Please send feedback if you have any success with it.

Great Circle Distance between two points, in miles

You can change the multiplier to get results in different measures. For example, change it to 5280 to get results in feet (instead of miles)

Function CalcDist(lon1 As Long, lat1 As Long, lon2 As Long, lat2 As Long) As Long
' great circle distance between two points in miles

Const r As Long = 3963
Const multiplier As Long = 1
Const divisor As Long = 57.2958

  CalcDist = multiplier * r * Excel.WorksheetFunction.Acos(VBA.Sin(lat1 / divisor) * _
                                                           VBA.Sin(lat2 / divisor) + VBA.Cos(lat1 / divisor) _
                                                         * VBA.Cos(lat2 / divisor) * VBA.Cos(lon2 / divisor - lon1 / divisor))

End Function

Sample Usage

Sub TestCalcDist()
  Debug.Print CalcDist(-122, 38, -123, 39)
End Sub

Remember this is great circle distance (i.e. "as the crow flies"), not door to door driving distance.

Great Circle Distance Using Web API

Geocoder also offers a free web service for requesting distance. Provide the latitude and longitude for both points and it returns the distance between them.

The only catch is that you cannot make more than one request every 15 seconds. To limit the amount of queries, they are cached in the local temp folder. In your VBA program you'll need to find a way to throttle new queries so that you don't hit this limit.

If you use the same coordinates, the cached response is returned, unless you specify True as the last parameter. This will force the function to re-query the web. I strongly discourage this, however, because the distance is extremely unlikely to change.

Be sure to copy the helper functions as well.

Function GetLatLongDist(lat1 As Long, lat2 As Long, lng1 As Long, lng2 As Long, _
                        Optional forceRequery As Boolean = False) As String

Dim URL As String
Dim xml As Object  ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String

Const baseURL As String = "http://geocoder.us/service/distance?lat1=38&lat2=39&lng1=-122&lng2=-123"
Const TXT_FILE_EXTENSION As String = ".txt"

  ' build URL
  URL = Replace(baseURL, "38", lat1)
  URL = Replace(URL, "39", lat2)
  URL = Replace(URL, "-122", lng1)
  URL = Replace(URL, "-123", lng2)

  ' store result in temp folder file
  tempFolder = environ("temp") & "\"
  tempFile = tempFolder & "latlongdist" & lat1 & lat2 & lng1 & lng2 & TXT_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", URL, False
      .send
    End With

    result = xml.responseText

    CreateFile tempFile, ConvertAccent(result)

  End If

  result = GetText(tempFile)

  GetLatLongDist = result

End Function

Sample Usage

Sub tst()
  Debug.Print GetLatLongDist(38, 39, -122, -123)
End Sub