Integrating Excel and Google Maps to Geo-code Your Addresses

My sister was looking for an easy way to calculate distances so I wrote her a couple macros that that she could use in Excel. The code is below for anyone who wants to borrow it and extend it further.

Using Google MAP APIs

Google provides a very well documented and easy to use API that is accessible through basic HTTP requests. The response it returns can be either JSON or XML format – in our case we’re using the XML format because the MSXML parser can easily parse it within an Excel Macro.

In order to use the XML parser, you need to have a reference to the Microsoft XML v6.0 COM object. In the macro editor, go under Tools –> References and make sure this component is checked. If the component isn’t in the list, you can browse to it – it should be located in the C:\Windows\System32 directory and the DLL is msxml6.dll.

Looking Up Longitude and Latitude

The objective in this scenario is pretty simple – take a list of addresses and geo-code them with longitude and latitude values.image

Google Maps API provides the ability to look up longitude and latitude:

https://maps.googleapis.com/maps/api/geocode/xml?address=New+York

Looking Up Distance

The objective in this scenario is to take a list of source and destination addresses and calculate the distance based on the shortest route that Google Maps calculates. The advantage of this approach is this factors in the specific routing through streets instead of calculating it “as the crow flies” (e.g. directly from one point to another).

Google Maps API provides the ability to look up directions and routes and provides a total distance in meters for each route.

https://maps.googleapis.com/maps/api/directions/xml?origin=Chicago&destination=Toronto

VBA Macro Code

Option Explicit

‘ Subroutine to plug in Longitude and Latitude for a range of locations.
Public Sub LookupLongitudeAndLatitude()

' Declare variables
Dim CurrentSheet As Worksheet
Dim CurrentRange As Range
Dim row As Range
Dim Address As String
Dim Longitude As Double
Dim Latitude As Double
Dim Success As Boolean
Dim BlankValues As Boolean
Dim Status As String

' Get the current selected cells
Set CurrentSheet = ActiveSheet
Set CurrentRange = Selection


' check for current range size to see if three columns are available.
If CurrentRange.Columns.Count <> 3 Then
    MsgBox ("Please select 3 columns, one with addresses in it and two blank to put the long and lat values")
Else

    For Each row In CurrentRange.Rows
      BlankValues = True
      Address = row.Cells(1, 1)

      ' Check for existing values.  We're expecting blank for columns 2 and 3 so if they have any content,
      ' we'll error out and send a warning isntead of writing over existing cells.
      If IsEmpty(row.Cells(1, 2)) <> True Then
        MsgBox ("Expected longitude column to be blank for cell " & row.Cells(1, 2).Address(False, False))
        BlankValues = False
      End If
      If IsEmpty(row.Cells(1, 3)) <> True Then
        MsgBox ("Expected latitude column to be blank for cell " & row.Cells(1, 3).Address(False, False))
        BlankValues = False
      End If

      If BlankValues = True Then
        Success = GetLongitudeAndLatitude(Address, Longitude, Latitude, Status)
        If Success = True Then
            row.Cells(1, 2) = Longitude
            row.Cells(1, 3) = Latitude
        Else
            row.Cells(1, 2) = Status
            row.Cells(1, 3) = Status
        End If

      End If
    Next row
End If

' reset selection to original range
CurrentSheet.Select
CurrentRange.Select

End Sub

Private Function GetLongitudeAndLatitude(Address As String, Longitude As Double, Latitude As Double, Status As String) As Boolean

' Declare variables and set return value to false by default
GetLongitudeAndLatitude = False
Dim response As DOMDocument60
Dim http As XMLHTTP60
Dim node As IXMLDOMNode
Dim nodes As IXMLDOMNodeList
Set http = New XMLHTTP60

' Read the data from the website
On Error Resume Next
' Open an XML request from Google using their GeoCode API
http.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?address=" & URLEncode(Address), False
http.send
Set response = http.responseXML

' get the status node.  This node tells you whether your search succeeded - OK means success.  Any other status means some kind of error or address not found.
Set node = response.SelectSingleNode("/GeocodeResponse/status")
If node.nodeTypedValue <> "OK" Then
    Status = node.nodeTypeString
Else
    Set nodes = response.SelectNodes("/GeocodeResponse/result")
    ' check for multiple addresses if we found more than 1 result then error out.
    If nodes.Length > 1 Then
        MsgBox ("Found Multiple Matches for Address: " & Address)
    Else
        ' grab the latitude and longitude from the XML response
        Set node = response.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat")
        Latitude = node.nodeTypedValue
        Set node = response.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng")
        Longitude = node.nodeTypedValue
        GetLongitudeAndLatitude = True
    End If

End If

Set http = Nothing
Set response = Nothing

End Function

‘ URL Encoding function courtesy of http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Private Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String

Dim StringLen As Long: StringLen = Len(StringVal)

If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String

If SpaceAsPlus Then Space = "+" Else Space = "%20"

For i = 1 To StringLen
  Char = Mid$(StringVal, i, 1)
  CharCode = Asc(Char)
  Select Case CharCode
    Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
      result(i) = Char
    Case 32
      result(i) = Space
    Case 0 To 15
      result(i) = "%0" & Hex(CharCode)
    Case Else
      result(i) = "%" & Hex(CharCode)
  End Select
Next i
URLEncode = Join(result, "")

End If
End Function

‘ Subroutine to plug in Distance between two addresses.
Public Sub LookupDistance()

' Declare variables
Dim CurrentSheet As Worksheet
Dim CurrentRange As Range
Dim row As Range
Dim SourceAddress As String
Dim DestinationAddress As String
Dim Distance As Double

Dim Success As Boolean
Dim BlankValues As Boolean
Dim Status As String

' select the currently selected range
Set CurrentSheet = ActiveSheet
Set CurrentRange = Selection

' check for current range size to see if three columns are available.
If CurrentRange.Columns.Count <> 3 Then
    MsgBox ("Please select 3 columns, one with source address, one with destination address and one for distance.")
Else

    For Each row In CurrentRange.Rows
      BlankValues = True
      SourceAddress = row.Cells(1, 1)
      DestinationAddress = row.Cells(1, 2)
      ' Check for existing values.  We're expecting blank for column 3 so if it contains any content,
      ' we'll error out and send a warning isntead of writing over existing cells.
      If IsEmpty(row.Cells(1, 3)) <> True Then
        MsgBox ("Expected distance column to be blank for cell " & row.Cells(1, 3).Address(False, False))
        BlankValues = False
      End If

      If BlankValues = True Then
        Success = GetDistance(SourceAddress, DestinationAddress, Distance, Status)
        If Success = True Then
            row.Cells(1, 3) = Distance
        Else
            row.Cells(1, 3) = Status
        End If

      End If
    Next row
End If

' reset selection to original range
CurrentSheet.Select
CurrentRange.Select

End Sub

Private Function GetDistance(SourceAddress As String, DestinationAddress As String, Distance As Double, Status As String) As Boolean

' Declare variables and set return value to false by default
GetDistance = False
Dim response As DOMDocument60
Dim http As XMLHTTP60
Dim node As IXMLDOMNode
Dim nodes As IXMLDOMNodeList
Set http = New XMLHTTP60

' Read the data from the website
On Error Resume Next

' Open an XML request from Google using their Directions API
http.Open "GET", "https://maps.googleapis.com/maps/api/directions/xml?origin=" & URLEncode(SourceAddress) & "&destination=" & URLEncode(DestinationAddress), False
http.send
Set response = http.responseXML

' get the status node.  If it isn't OK then we have either an error or no address found.
Set node = response.SelectSingleNode("/DirectionsResponse/status")
If node.nodeTypedValue <> "OK" Then
    Distance = 0
    Status = node.nodeTypedValue
Else
    Set nodes = response.SelectNodes("/DirectionsResponse/route")
    If nodes.Length > 1 Then
        ' this should never happen unless alternatives=true is added on to the URL above.
        MsgBox ("Found Multiple Routes for Source Address " & SourceAddress & " and Destination Address " & DestinationAddress & ".")
    Else
        ' Grab the distance value from the XML - it's in meters so we'll divide by 1000 to convert to KM
        Set node = response.SelectSingleNode("/DirectionsResponse/route/leg/distance/value")
        If node Is Not Null Then
            Distance = node.nodeTypedValue
            Distance = Distance / 1000
            GetDistance = True
        End If

    End If

End If

Set http = Nothing
Set response = Nothing

End Function

Christopher Woodill

About ME

Enterprise technology leader for the past 15+ years…certified PMP, Six Sigma Black Belt and TOGAF Enterprise Architect. I collaborate with companies to help align their strategic objectives with concrete implementable technology strategies. I am Vice President, Enterprise Solutions for Klick Health.

Leave a Comment