Speeding up Excel distance calculation using Bing API calls 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:



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 = "&amp;destinations="
    lastVal = "&amp;travelMode=driving&amp;o=xml&amp;key=&lt;My Key&gt;&amp;distanceUnit=mi"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = firstVal &amp; start &amp; secondVal &amp; dest &amp; 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) &amp; " 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 = "&amp;destinations="
    lastVal = "&amp;travelMode=driving&amp;o=xml&amp;key=&lt;My Key&gt;&amp;distanceUnit=mi"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = firstVal &amp; start &amp; secondVal &amp; dest &amp; 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) &amp; " 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&amp;adminDistrict="
    secondVal = "&amp;locality="
    thirdVal = "&amp;postalCode="
    fourthVal = "&amp;addressLine="
    lastVal = "&amp;maxResults=1&amp;o=xml&amp;key=&lt;My Key&gt;"
    Url = firstVal &amp; state &amp; secondVal &amp; city &amp; thirdVal &amp; zip &amp; fourthVal &amp; address &amp; 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") &amp; "," &amp; WorksheetFunction.FilterXML(objHTTP.responseText, "//Point//Longitude")
End Function


To be clear, the process works well, just extremely slowly. Any thoughts on speeding this up?
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 &amp; Cell &amp; "&amp;wp.1=" &amp; Cell.Offset(0, 1) &amp; "&amp;key=" &amp; APIKey &amp; "&amp;DistanceUnit=mi&amp;DurationUnit=min&amp;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 &lt;&gt; 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 --&gt; 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