6
\$\begingroup\$

I am writing VBA in Excel to calculate the distance between an employee's home address and work address using Bing Maps API calls. The process follows this general flow:

1) Convert the employee's address to Lat-Long values using the GetLatLong function

2) Convert the employee's work address to Lat-Long values using the GetLatLong function

3) Calculate the distance between these two points using the GetDistance function

4) Calculate the drive time between these two points using the GetTime function

The spreadsheet looks like this:

enter image description here

The process is working, but it is excruciatingly slow. The employee population is approximately 2300, and it takes almost an hour to execute.

I am not a coder, but I can functionally modify found code to my purposes. This is an amalgamation of multiple different processes found through Google searches. The code pieces in use are:

Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins="
    secondVal = "&destinations="
    lastVal = "&travelMode=driving&o=xml&key=<My Key>&distanceUnit=mi"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = firstVal & start & secondVal & dest & lastVal
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    GetDistance = Round(WorksheetFunction.FilterXML(objHTTP.responseText, "//TravelDistance"), 0) & " miles"
End Function

Public Function GetTime(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins="
    secondVal = "&destinations="
    lastVal = "&travelMode=driving&o=xml&key=<My Key>&distanceUnit=mi"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = firstVal & start & secondVal & dest & lastVal
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    GetTime = Round(WorksheetFunction.FilterXML(objHTTP.responseText, "//TravelDuration"), 0) & " minutes"
End Function

Public Function GetLatLong(address As String, city As String, state As String, zip As String)
    Dim firstVal As String, secondVal As String, thirdVal As String, fourthVal As String, lastVal As String
    firstVal = "https://dev.virtualearth.net/REST/v1/Locations?countryRegion=United States of America&adminDistrict="
    secondVal = "&locality="
    thirdVal = "&postalCode="
    fourthVal = "&addressLine="
    lastVal = "&maxResults=1&o=xml&key=<My Key>"
    Url = firstVal & state & secondVal & city & thirdVal & zip & fourthVal & address & lastVal
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    GetLatLong = WorksheetFunction.FilterXML(objHTTP.responseText, "//Point//Latitude") & "," & WorksheetFunction.FilterXML(objHTTP.responseText, "//Point//Longitude")
End Function

To be clear, the process works well, just extremely slowly. Any thoughts on speeding this up?

\$\endgroup\$
  • \$\begingroup\$ As far as I can tell the bulk of the work is spent waiting for synchronous REST API calls - and VBA UDFs don't run asynchronously. The obvious solution is to ditch VBA and use Office-JS. Is this Office 365? Can it be migrated to Excel Online? Otherwise, the only thing I can think of is to implement a "refresh" macro with VSTO and leverage async/await in .net - populating the sheet as the results come in (or all at once, after everything is done). \$\endgroup\$ – Mathieu Guindon May 28 at 21:11
  • \$\begingroup\$ MSXML2.ServerXMLHTTP supports asynchronous requests - does it have to be UDFs, or can the code be refactored into a macro that populates the worksheet cells? Leveraging asynchronous requests could dramatically cut the time it takes to update this data. \$\endgroup\$ – Mathieu Guindon May 29 at 15:35
  • \$\begingroup\$ Ultimately the slowness is caused by the round-trip time of each API call. Since the time for your entire program to run is basically the sum of these calls, you only have 2 options: 1) Reduce calls/ running time per call by - sending all requests at once (definitely the fastest, does your api allow sending batches?), caching results (save distance and time for a given start/dest pair), parallel requests (if the api doesn't throttle requests, also if VBA can handle it) etc. 2) Make running time unimportant - run in separate thread/async so Excel doesn't freeze - run through a macro etc. \$\endgroup\$ – Greedo May 29 at 15:59
4
\$\begingroup\$

Depending on what you want to return you can actually leverage just one API method from Bing to retrieve the data you are after, the Driving Route API. Also, as others have pointed out what's killing performance is the synchronous code.

What I've done below is limited the pull to a single request, and made the code asynchronous.

I've also changed this code to a sub, as I'd need to iterate over some sort of collection. For ease of use, I used a range.

I've structured my data as the from address being in the first column of the range, and the destination address being in the column immediately after that. Travel Distance and Travel Duration will be output offset relative to the from address (2 and 3 columns offset respectively).

I did a quick benchmark, this is taking just over 4 seconds for 250 requests. Hope it helps!

Option Explicit

Const BaseURL As String = "http://dev.virtualearth.net/REST/V1/Routes/Driving?wp.0="
Const APIKey  As String = "YOUR_KEY"
Private Const READYSTATE_COMPLETE  As Long = 4

Public Sub GetDistances(Addresses As Range)
    Dim Server           As Object
    Dim ServerItem       As Variant
    Dim Servers          As Object
    Dim Cell             As Range
    Dim URL              As String

    Set Servers = CreateObject("Scripting.Dictionary")

    'Send all the requests up front, but don't wait for them to complete
    For Each Cell In Addresses
        'See here: https://docs.microsoft.com/en-us/bingmaps/rest-services/examples/driving-route-example for more details on this api
        URL = BaseURL & Cell & "&wp.1=" & Cell.Offset(0, 1) & "&key=" & APIKey & "&DistanceUnit=mi&DurationUnit=min&output=xml"
        Set Server = CreateObject("MSXML2.ServerXMLHTTP")
        Server.Open "GET", URL, True 'Last param will make request async
        Server.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        Server.send ("")
        Servers.Add Cell.Address, Server
    Next

    'Iterate each XML request sent to see if done
    For Each ServerItem In Servers.Keys()
        Set Server = Servers(ServerItem)

        While Server.readyState <> READYSTATE_COMPLETE
            DoEvents
        Wend

        'Parse result
        If Server.Status = 200 Then
            'Add result to the sheet to an offsetting column
            Addresses.Parent.Range(ServerItem).Offset(0, 2) = WorksheetFunction.FilterXML(Server.ResponseText, "/Response/ResourceSets/ResourceSet/Resources/Route/TravelDistance")
            Addresses.Parent.Range(ServerItem).Offset(0, 3) = WorksheetFunction.FilterXML(Server.ResponseText, "/Response/ResourceSets/ResourceSet/Resources/Route/TravelDuration") / 60
            'You can also return the lat/long from this request, see --> https://docs.microsoft.com/en-us/bingmaps/rest-services/examples/driving-route-example
        End If
    Next

End Sub

Sub ProcessData()
    Dim myRng As Range
    Dim t As Double
    t = Timer
    Set myRng = ThisWorkbook.Sheets(1).Range("A1:a250")
    GetDistances myRng
    Debug.Print Timer - t
End Sub
\$\endgroup\$
3
\$\begingroup\$

GetTime and GetDistance look very, very similar. In fact, they're identical, save for how the XML response is parsed:

Public Function GetDistance(start As String, dest As String)
    '...
    GetDistance = Round(WorksheetFunction.FilterXML(objHTTP.responseText, "//TravelDistance"), 0) & " miles"
End Function

Public Function GetTime(start As String, dest As String)
    '...
    GetTime = Round(WorksheetFunction.FilterXML(objHTTP.responseText, "//TravelDuration"), 0) & " minutes"
End Function

This is great news: it means there's an opportunity to slash the total execution time by a third, by reducing the number of REST API calls you need to wait for by as much.

The first step is to remove all redundancies. Ultimately we want the 3 functions to look something like this:

Public Function GetDistance(ByVal start As String, ByVal dest As String) As Double
    GetDistance = VirtualEarthAPI.DistanceMatrix(start, dest).Distance
End Function

Public Function GetTravelTime(ByVal start As String, ByVal dest As String) As Date
    GetTravelTime = VirtualEarthAPI.DistanceMatrix(start, dest).TravelTime
End Function

Public Function GetLatLong(ByVal address As String, ByVal city As String, ByVal state As String, ByVal zip As String) As String
    GetLatLong = VirtualEarthAPI.LocationPoint(address, city, state, zip)
End Function

Note that the GetDistance function now return a Double, and leave the formatting of that numeric value up to the client (i.e. the worksheet) - knowing that a number representing distance in miles needs to look like 123.45 miles is a concern for the consumer of this function, not the function itself. As a bonus with the distances now understood as the numeric values they are by Excel, you can do math on these numbers and calculate average distances if you need to. The NumberFormat for distance could be #,##0.00 "miles", for example.

Same with GetTravelTime: by returning a Date (using the VBA.DateTime.TimeSerial function to build it from the number of minutes returned by the API), you can have a NumberFormat for these values that looks like hh:mm, and now Excel can perform math on these values, too.

You have all parameters implicitly passed by reference (ByRef), but they should all be passed by value (ByVal); the functions' return type was also implicitly Variant - specifying an explicit return type makes a much cleaner API to use, especially if any VBA code needs to invoke these functions.

You could use a Scripting.Dictionary to cache the responses for DistanceMatrix, keyed with {start}->{dest} strings that would be easy to lookup from the start and dest arguments: if the dictionary contains that key, you return the cached response; otherwise, you make the HTTP request, cache the response, and return it.

But that's still synchronous, and while caching DistanceMatrix responses would essentially cut 33% of the total update time, we're still looking at almost 40 minutes (extrapolated from "almost an hour") to update, which makes it a lot of work for relatively little gain. The biggest win would be to change the strategy entirely, and replace the user-defined functions with a macro, which might look like this:

Option Explicit
Private macro As New EmployeeTableUpdaterMacro

Public Sub UpdateEmployeeTableAsync()
    macro.ExecuteAsync
End Sub

The logic would need to move to a new EmployeeTableUpdaterMacro class module that exposes a Public Sub ExecuteAsync() procedure and proceeds to update the data in the employee table using asynchronous HTTP requests, i.e. updating the values as they come, possibly while displaying a progress indicator (or updating the Application.StatusBar) showing how many requests were sent vs. how many responses were received.

\$\endgroup\$
  • \$\begingroup\$ Worth noting perhaps that while this does reduce running time significantly, there is nothing you can do in VBA or any other language to make your internet connection faster. That means unless there is some way to send a batch of requests at once, the minimum running time of this code will always be dictated by the number of requests (udf/macro, sync/async). I think the main take-away here is that by providing progress indication/ running as a macro, the slow execution becomes manageable and acceptable. Well ok, that 33% reduction is pretty good too I suppose;) \$\endgroup\$ – Greedo May 29 at 16:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.