Calculate distance between UK postcodes with VBA in Excel

[GVK]

Hi, I would like to calculate the driving distance in miles or kms for a list of UK postcodes in Excel, I assume through the use of VBA. Based on general research it seems this is something that is indeed possible but I cannot seem to find a VBA code that works. Does anyone have any tip/s on how to do this please? Thank you.

 

[John_w]

You could use the Microsoft Bing Maps API (you must create an API key and specify it in the request). Example code here:

Calculate the distance between 2 postcodes in miles

Hi, i am wanting to be able to calculate the distance between 2 postcodes in excel. i have a list of around 3000 places in the UK and i am wanting to know which is the closest to were i currently am. To do this i am wanting to be able to put a column on the end (e.g. column f) to work out how...

www.mrexcel.com

For a matrix of postcode origins and destinations the Google Maps Distance Matrix API is more efficient because you can specify up to 25 origins and 25 destinations in one request and it returns the results for every origin and destination pair in a single response. You must register your 'project' in the Google Cloud Platform Console and note that there is a billing plan (cost) for using the API, though the first $200 USD per month is free.

This example macro calls the Distance Matrix API with 4 different postcodes - 2 origin postcodes and 2 destination postcodes. The API's response contains the results for each pair: 4 distances in km and durations in hours and minutes, which are output to the VBA Immediate window.

Public Sub Google_Distance_Matrix_API()

    Const APIkey = "Your_Google_API_key"

    Dim origins As String
    Dim destinations As String
    Dim URL As String
   
    Dim DOMdoc As Object 'DOMDocument60
    Set DOMdoc = CreateObject("MSXML2.DOMDocument") 'New DOMDocument60
   
    Dim StatusNode As Object 'IXMLDOMNode
    Dim originAddressNodes As Object 'IXMLDOMNodeList
    Dim destinationAddressNodes As Object 'IXMLDOMNodeList
    Dim rowNodes As Object 'IXMLDOMNodeList
    Dim elementNodes As Object 'IXMLDOMNodeList
    Dim element As Object 'IXMLDOMNode
    Dim r As Long, c As Long
   
    origins = Join(Array("postcode1", "postcode2"), "|")  'SPECIFY ACTUAL POSTCODES
    destinations = Join(Array("postcode3", "postcode4"), "|")  'SPECIFY ACTUAL POSTCODES
   
    URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?" & _
                "origins=" & Application.WorksheetFunction.EncodeURL(origins) & _
                "&destinations=" & Application.WorksheetFunction.EncodeURL(destinations) & _
                "&mode=driving&key=" & APIkey
   
    With DOMdoc
        .async = False
        .Load URL      
        Set StatusNode = .SelectSingleNode("/DistanceMatrixResponse/status")
        Set originAddressNodes = .selectNodes("/DistanceMatrixResponse/origin_address")
        Set destinationAddressNodes = .selectNodes("/DistanceMatrixResponse/destination_address")
        Set rowNodes = .selectNodes("/DistanceMatrixResponse/row")
     End With
    
     If StatusNode.Text = "OK" Then
        For r = 0 To rowNodes.Length - 1
            Set elementNodes = rowNodes(r).selectNodes("element")
            For c = 0 To elementNodes.Length - 1
                Set element = elementNodes(c)
                If element.SelectSingleNode("status").nodeTypedValue = "OK" Then
                    If originAddressNodes(r).Text <> destinationAddressNodes(c).Text Then
                        Debug.Print originAddressNodes(r).Text & " to " & destinationAddressNodes(c).Text
                        Debug.Print element.SelectSingleNode("distance/text").Text & ", " & _
                                    element.SelectSingleNode("duration/text").Text
                    End If
                End If
            Next
        Next
    Else
        Debug.Print StatusNode.Text
    End If
   
End Sub

 

[GVK]

Thank you for this John!

I created a Bing APIkey and executed the code but I get "Request_Denied" in the Immediate window. Unsure why?

Do I need to replace the above Google-based URL with the equivalent for Microsoft/BING?

Also is there a way to refence a range of cells in Excel for all postcodes instead of manually inputting these 1-by-1 in the array formula above?

 

[John_w]

My macro above is specific to the Google Maps Distance Matrix API, which requires a Google API key, and wouldn't work with Bing.

The VBA code for Bing is in @MARK858's post which I posted a direct link to. His code is 2 UDF's (GetDistance and GetTimeinMins) which can be called as worksheet functions, for example =GetDistance("T2P 4R5", "M9N 1K9"), or from a macro.

My macro in post #14 of that thread shows how to reference a range of cells for all the postcodes and call the GetDistance function, which I repeat below. With the start postcodes in column A and the end postcodes in column B, both starting at row 2, this loops through the cells and puts the calculated distance in miles in column C:

Public Sub Calculate_Distances()

    Dim cell As Range
   
    With ActiveSheet
        For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            cell.Offset(, 2).Value = GetDistance(cell.Value, cell.Offset(, 1).Value) * 1.60934
        Next
    End With
   
End Sub

Put Mark's code and my Calculate_Distances macro in a standard module and run Calculate_Distances.

NOTE - the two t = "http://dev.virtualearth.net/REST/V1/Routes/Driving ....." lines in Mark's code have been corrupted with HTML markup after a forum software update. Both lines should be:

    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=YOUR_MS_KEY"

 

[GVK]

This is exactly what I was looking for! Many thanks for helping out John, much appreciated!