Home » excel » vba – Using Google Maps Distance Matrix API on Excel with less API calls

vba – Using Google Maps Distance Matrix API on Excel with less API calls

Posted by: admin April 23, 2020 Leave a comment

Questions:

Part of an excel spreadsheet I’m creating is a grid of 8 different locations and the distance between them pulled from the Google Maps Distance Matrix API. The locations are entered from a table and will be changed regularly.

The VBA code I’m currently using is:

   'Calculate Google Maps distance between two addresses
Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "+UK&destinations="
    lastVal = "+UK&mode=car&language=en&sensor=false"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDistance = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    GetDistance = -1
End Function

I then call it in the spreadsheet using the simple function:

=GetDistance($D$14,B15)

This script works well but it does mean that I’m doing 56 API calls each time the spreadsheet loads and each time I change any of the locations, and hence I’m hitting the 2500 API call limit quite quickly.

Is there a way of making the function only pull data at a specific time, (at the click of a button, for example), or simply getting the same data in less API calls?

How to&Answers:

By adding a button (to only refresh if it is pressed) and a collection holding all values you got so far, you should be able to decrease the amounds of calls…

Option Explicit

Public gotRanges As New Collection 'the collection which holds all the data
Public needRef As Range 'the ranges which need to be recalculated
Public refMe As Boolean 'if true GetDistance will update if not in collection

Public Function GetDistance(start As String, dest As String)
  Dim firstVal As String, secondVal As String, lastVal As String, URL As String, tmpVal As String
  Dim runner As Variant, objHTTP, regex, matches
  If gotRanges.Count > 0 Then
    For Each runner In gotRanges
      If runner(0) = start And runner(1) = dest Then
        GetDistance = runner(2)
        Exit Function
      End If
    Next
  End If
  If refMe Then
    firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "+UK&destinations="
    lastVal = "+UK&mode=car&language=en&sensor=false"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDistance = CDbl(tmpVal)
    gotRanges.Add Array(start, dest, GetDistance)
    Exit Function
  Else
    If needRef Is Nothing Then
      Set needRef = Application.Caller
    Else
      Set needRef = Union(needRef, Application.Caller)
    End If
  End If
ErrorHandl:
  GetDistance = -1
End Function

Public Sub theButtonSub() 'call this to update the actual settings
  Dim runner As Variant
  refMe = True
  If Not needRef Is Nothing Then
    For Each runner In needRef
      runner.Offset.Formula = runner.Formula
    Next
  End If
  Set needRef = Nothing
  refMe = False
End Sub

having a, b and c (which would load 6 times) will not load again if you change them to c, a and b (if you get what i mean…

if you still have questions, just ask 🙂