Calculate the distance between 2 postcodes in miles

J

Jaffabfc

Board Regular
Joined
Jul 5, 2013
Messages
230
Office Version
  1. 365
Platform
  1. Windows
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 much it is from A to B, is this even possible?

I am hoping there is something simple that i can do even if it means linking google maps into it.

Thanks
 
Sort by date Sort by votes
Awesome! Thanks, man! It works now :) Any idea how I could modify it to return distance in Km instead of miles?


John_w said:
I have updated the two functions to parse the XML response and return the distance and time.

Code: 
Const APIkey = "YourAPIkey"

Function GetDistance(sPCode As String, ePcode As String) As Double

    Dim t As String, s As Variant
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim re As XMLHTTP60
        Set re = New XMLHTTP60
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim re As XMLHTTP
        Set re = New XMLHTTP
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=" & APIkey
    
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
    
    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetDistance = .SelectSingleNode("//ns:TravelDistance").Text
        Debug.Print .SelectSingleNode("//ns:DistanceUnit").Text
    End With
    
End Function


Function GetTimeinMins(sPCode As String, ePcode As String) As Double
    Dim t As String, s As Variant
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim re As XMLHTTP60
        Set re = New XMLHTTP60
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim re As XMLHTTP
        Set re = New XMLHTTP
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=" & APIkey
    
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
    
    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetTimeinMins = .SelectSingleNode("//ns:TravelDuration").Text / 60
        Debug.Print .SelectSingleNode("//ns:DurationUnit").Text
    End With
    
End Function
=GetDistance("T2P 4R5", "M9N 1K9") returns 2240.836018 (miles) for me.
Click to expand...
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
How could I possibly implement this function over an large array of cells (I have to calculate distance for about 6,000 entries). Doing this by manually entering each postal code might take a very long time. IS there a way to implement this function over large number of columns, as it only takes in the postal codes as strings and cell referencing doesn't seem to work..


bdeeve8 said:
Awesome! Thanks, man! It works now :) Any idea how I could modify it to return distance in Km instead of miles?
Click to expand...
 
Upvote 0
Cell referencing works for me:

=GetDistance(A2,B2)*1.60934 gives 3606 Km for the 2 post codes.

As you have many post codes it would be far better to run a macro which calculates all the distances, instead of calling a UDF for each distance. With the post codes in columns A and B starting at row 2, this puts the calculated distance in column C:

Code: 
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
 
Upvote 0
I found this app that I did years ago for a client. Maybe this function and info will help.

A column (starting in A3) has zips "from" and row 2 has zips "to" (starting in B3).

B3, for example, has this code:

Code: 
=IFERROR(3960*CentralAngle(VLOOKUP($A3,zipinfo!$C$2:$E$33248,2,FALSE),VLOOKUP($A3,zipinfo!$C$2:$E$33248,3,FALSE),VLOOKUP(B$2,zipinfo!$C$2:$E$33248,2,FALSE),VLOOKUP(B$2,zipinfo!$C$2:$E$33248,3,FALSE)),"")

which is filled across and down.

This function does the trigonometry:

Code: 
Function CentralAngle(ByVal lat1 As Double, ByVal lon1 As Double, _
                      ByVal lat2 As Double, ByVal lon2 As Double) As Double
    ' shg 2008-1111
    
    ' Returns central angle between two point in RADIANS
    ' using Vincenty formula

    Const pi    As Double = 3.14159265358979
    Const D2R   As Double = pi / 180#

    Dim dLon    As Double
    Dim x       As Double
    Dim y       As Double

    ' convert angles from degrees to radians
    lat1 = D2R * lat1
    lon1 = D2R * lon1
    lat2 = D2R * lat2
    lon2 = D2R * lon2

    dLon = lon2 - lon1  ' delta lon

    x = Sin(lat1) * Sin(lat2) + Cos(lat1) * Cos(lat2) * Cos(dLon)
    y = Sqr((Cos(lat2) * Sin(dLon)) ^ 2 + (Cos(lat1) * Sin(lat2) - Sin(lat1) * Cos(lat2) * Cos(dLon)) ^ 2)
    CentralAngle = WorksheetFunction.Atan2(x, y)
End Function

It needs a sheet called "zipinfo" that contains the zip codes in column C, has the state abbreviation in col A, the latitude in D and longitude in E.

I put a similar calculation in the zipinfo sheet.

[TABLE="width: 611"]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[TD]



[/TD]
[/TR]
[/TABLE]
 
Last edited:
Upvote 0
This works for the United States...probably something could be adopted for the UK or elsewhere with Post Codes unlike the US.

Just need the long. and lat. to make the calculations work.
 
Upvote 0
John_w said:
I have updated the two functions to parse the XML response and return the distance and time.

Code: 
Const APIkey = "YourAPIkey"

Function GetDistance(sPCode As String, ePcode As String) As Double

    Dim t As String, s As Variant
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim re As XMLHTTP60
        Set re = New XMLHTTP60
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
        Dim re As XMLHTTP
        Set re = New XMLHTTP
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
   
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=" & APIkey
   
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
   
    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetDistance = .SelectSingleNode("//ns:TravelDistance").Text
        Debug.Print .SelectSingleNode("//ns:DistanceUnit").Text
    End With
   
End Function


Function GetTimeinMins(sPCode As String, ePcode As String) As Double
    Dim t As String, s As Variant
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim re As XMLHTTP60
        Set re = New XMLHTTP60
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
        Dim re As XMLHTTP
        Set re = New XMLHTTP
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
   
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=" & APIkey
   
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
   
    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetTimeinMins = .SelectSingleNode("//ns:TravelDuration").Text / 60
        Debug.Print .SelectSingleNode("//ns:DurationUnit").Text
    End With
   
End Function
=GetDistance("T2P 4R5", "M9N 1K9") returns 2240.836018 (miles) for me.
Click to expand...
Is this code still working? I am trying to use with UK post codes (Similar to Canadians) and constantly get error message #NAME? in the destination cell. I have registered and received a key from MS Bing maps so am not sure what is going on at all. Thanks for the reply in advance
 
Upvote 0
Yes, the code still works. The #NAME? error indicates the function isn't named GetDistance, or you haven't put the code in a standard module.

The original code uses early binding of the XMLHTTP object and therefore requires a reference to Microsoft XML v6.0. Here is the code reposted to use late binding so that the reference isn't needed.

VBA Code: 
Option Explicit

Const APIkey = "Your BING API key"

Function GetDistance(sPCode As String, ePcode As String) As Double

    Dim t As String, s As Variant
    Static re As Object
    If re Is Nothing Then Set re = CreateObject("MSXML2.XMLHTTP")

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

    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4

    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetDistance = .SelectSingleNode("//ns:TravelDistance").Text
        Debug.Print .SelectSingleNode("//ns:DistanceUnit").Text
    End With

End Function


Function GetTimeinMins(sPCode As String, ePcode As String) As Double
    Dim t As String, s As Variant
    Static re As Object
    If re Is Nothing Then Set re = CreateObject("MSXML2.XMLHTTP")

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

    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4

    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetTimeinMins = .SelectSingleNode("//ns:TravelDuration").Text / 60
        Debug.Print .SelectSingleNode("//ns:DurationUnit").Text
    End With

End Function
=GetDistance("T2P 4R5", "M9N 1K9") now returns 2376.182469 (miles).
 
Upvote 0
John_w said:
Yes, the code still works. The #NAME? error indicates the function isn't named GetDistance, or you haven't put the code in a standard module.

The original code uses early binding of the XMLHTTP object and therefore requires a reference to Microsoft XML v6.0. Here is the code reposted to use late binding so that the reference isn't needed.

VBA Code: 
Option Explicit

Const APIkey = "Your BING API key"

Function GetDistance(sPCode As String, ePcode As String) As Double

    Dim t As String, s As Variant
    Static re As Object
    If re Is Nothing Then Set re = CreateObject("MSXML2.XMLHTTP")

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

    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4

    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetDistance = .SelectSingleNode("//ns:TravelDistance").Text
        Debug.Print .SelectSingleNode("//ns:DistanceUnit").Text
    End With

End Function


Function GetTimeinMins(sPCode As String, ePcode As String) As Double
    Dim t As String, s As Variant
    Static re As Object
    If re Is Nothing Then Set re = CreateObject("MSXML2.XMLHTTP")

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

    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4

    With re.responseXML
        .SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.microsoft.com/search/local/ws/rest/v1'"
        GetTimeinMins = .SelectSingleNode("//ns:TravelDuration").Text / 60
        Debug.Print .SelectSingleNode("//ns:DurationUnit").Text
    End With

End Function
=GetDistance("T2P 4R5", "M9N 1K9") now returns 2376.182469 (miles).
Click to expand...
Beautiful! It works perfectly now. Thanks so much for your reply. Much appreciated
 
Upvote 0
I've added the Microsoft XML v6.0 reference in VBA but i'm getting #NAME? when I try to use =GetDistance("T2P 4R5", "M9N 1K9")
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Dynamic Rate Formula Google sheets
Replies
2
Views
96
invalidlabel
I
R
  • Question Question
Google Spread sheet automation & rights
Replies
0
Views
105
RAMU
R
C
  • Solved
Cumulative sum with multiple criteria
Replies
4
Views
540
Fluff
Fluff
C
  • Solved
Using BING MAPS get miles
2 3
Replies
20
Views
2K
johnnyL
J
T
  • Question Question
Golf Simulator League - Calculating Golf Handicaps for Google Sheets
2
Replies
16
Views
4K
Fluff
Fluff

Forum statistics

Threads
1,223,246
Messages
6,170,988
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top