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.

image

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).

image

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
  • im searching a way to try get the city from a zipcode and another to get a zipcode by city…. you know how can i do that?

  • rsd schools

    I’m a little late, but other people will certainly see this, and the following instructions worked for me in Office 2007 version (although I don’t think the version should matter… It’s more about the *references* allowed on your particular Office Install/Machine. The code makes use of Microsoft’s XML library and you’ll need to add a reference to it. To do that In Excel, press ALT+F11 to get into VBE. Then do the following:


    Click the “Tools” menu option and select “References”. A list of checkboxes will pop up. You need to locate “Microsoft XML v6.0″ from the list and check it. Thankfully, the libraries are in alphabetical order. Mine looks like this, of course, I’ve already checked the reference so the library is at the top of the list. When you’re done, click “OK”. I will source the instructions which I provided with a hyperlink if I’m allowed to do so on this post.

    A photo is attached. Good luck.

  • Marc Peltier

    I’m a little late, but other people will certainly see this and need assistance. The following instructions worked for me in the 2007 version of MS Office. By the way, while speaking in terms of a potential solution, I don’t think the Office version should be of much relevance. This problem that you’re having is likely related to the *references* allowed on your particular Office Install/Machine. Open your file in Excel, and then press ALT+F11 to get into VBE. Once this is done, read and do the following:

    The code makes use of Microsoft’s XML library and you’ll need to add a reference to it. Click the “Tools” menu option and select “References”. A list of checkboxes will pop up. You need to locate “Microsoft XML v6.0″ from the list and check it. Thankfully, the libraries are in alphabetical order. Mine looks like this, of course, I’ve already checked the reference so the library is at the top of the list. When you’re done, click “OK”.

    Have a look at the photo, and good luck.

  • Pingback: Help - Geocoding (I think) - Page 2()

  • Lindsey

    Would you kindly provide the code to execute this macro in excel 2013? Thank you! 🙂

  • Christopher Woodill

    The code will work in Excel 2013 but you’ll need to reference the Microsoft XML 6.0 component. I have updated the blog post to show how this is done.

  • Camilo Vargas

    Hi, Thanks, Excelent work. Do you have also the way to find the time?

  • Adalsteinn

    response As DOMDocument60
    I stop on this,

    I have already put in reference Microsoft XML v6.0 tools
    Do you know what might be stopping me?

  • Adalsteinn

    I am trying to find the destination between Reykjavík and Boston but it gives Zero_results and/or not_found.. But for instance Chicago – Boston is fine.

  • rachid

    Hi can anyone give me the steps to genarate the longittude and latitude from adress in exel

    adress | longitude | latitude

    i have the adress and i need to generate the long and lat

    thanks in advance 🙂

  • Bernd Carstens

    Hi, i have integrated the code into my excel 2013, what is the function name in the excel sheet to generate the latitude ?

  • Bernd Carstens

    i got it

  • Ester

    First of all thanks for sharing the code, it is very useful!!
    I have encountered a problem with third column returning “OVER_QUERY_LIMIT”

    It worked fine for a 3 queries earlier this morning, and then I tried with 5000 entries, excel could not cope with that and around 10th rows it has stopped and started populating with “OVER_QUERY_LIMIT”, so I restarted the programme and tried again. Now, even I only selected 1 row 3 cells, the third column still returns “OVER_QUERY_LIMIT”

    Please can anyone can suggest any solutions?
    Thanks!