Calculate distance between 2 postcode

gazmoz17

Board Regular
Joined
Sep 18, 2020
Messages
158
Office Version
  1. 365
Platform
  1. Windows
Hi,

Is it possible to do this in excel? I have a single column of customer postcodes. I wish to compare this column to the same source/origin postcode each time.

So one of the lookup postcodes is the same each time.

Any help much appreciated.

Thanks
Gareth
 
Hi, yeah I thought so and I have used it successfully in the past. Thats all its pasted each time despite the message box saying its copied to the window. The last 3 goes after copying to clipboard it doesn’t paste anything at all. I’ll delete and reinstall the addin when back in work tomorrow.

But theres nothing to see really, just per my image is what Im trying to achieve if possible? Google maps distance between column A and Col B, column B is always the same. Some sort of API key to google maps or anything similar to google maps.

Thanks
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Using Google API you should able to search more than zipcodes. See example below. Try this.

VBA Code:
Function GetDistance(origin As String, destination As String) As String
    Dim apiKey As String
    Dim url As String
    Dim responseText As String
    Dim objHTTP As Object
    Dim distance As String
    
    ' Replace "YOUR_API_KEY" with your actual API key
    apiKey = "YOUR_API_KEY"
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & origin & "&destinations=" & destination & "&units=imperial&key=" & apiKey

    ' Send HTTP request to the Distance Matrix API
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", url, False
    objHTTP.send

    responseText = objHTTP.responseText
    ' Parse the JSON response to extract distance
    If InStr(responseText, "OK") > 0 Then
        distance = Split(Split(responseText, """text"" : """)(1), """")(0)
    Else
        distance = "Error"
    End If
    
    ' Return the distance
    GetDistance = distance
End Function

Book1
ABCD
1OriginDestinationDistance
2Dallas, TexasIrving, California1,421 mi
3OX14 5PBWA7 5PS167 mi
4RG8 7JFWA7 5PS186 mi
5
Sheet1
Cell Formulas
RangeFormula
C2:C4C2=GetDistance(A2,B2)
 
Last edited:
Upvote 0
Solution
Wow thanks for this cubist 😄. I’ll have a look in work tomorrow thank you, much appreciated 👍
 
Upvote 0
Absolutely amazing, thank you for your time 👍. I was able to match customer Postcode to a zone (zones per our Courier provider) but strangley the same zone can be at opposite ends of the uk. So better to return "miles" and then segment customers every 50 miles etc.

Is there a way to return driving time?

Is every row of data 1 API call (eg 1 comparison) or 2 calls ( an API lookup for each postcode on the same row both "Origin" & "Destination")

If I didnt want an "Orign" col (to keep table more concise) as Origin is always the same postcode. Can this same repeating postcode be hardcoded in the VBA code itself?

Many Thanks
 
Upvote 0
Thanks for the feedback. To return the driving time, change 1 to 2 on this line.
VBA Code:
distance = Split(Split(responseText, """text"" : """)(1), """")(0)

If you want km instead of miles, change "imperial" to "metric" on this line.
VBA Code:
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & origin & "&destinations=" & destination & _
                            "&units=imperial&key=" & apiKey

To hardcode the destination, eliminate the second requirement like here.
VBA Code:
Function GetDistance(origin As String) As String
    Dim apiKey As String
    Dim url As String
    Dim responseText As String
    Dim objHTTP As Object
    Dim distance As String
    
    destination = "WA7 5PS"
    
    ' Replace "YOUR_API_KEY" with your actual API key
    apiKey = "YOUR_API_KEY"
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & origin & "&destinations=" & destination & _
                            "&units=imperial&key=" & apiKey 'change "imperial" to "metric" if you want km

    ' Send HTTP request to the Distance Matrix API
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", url, False
    objHTTP.send

    responseText = objHTTP.responseText
    ' Parse the JSON response to extract distance
    If InStr(responseText, "OK") > 0 Then
        distance = Split(Split(responseText, """text"" : """)(1), """")(0) 'change 1 to 2 for driving duration
    Else
        distance = "Error"
    End If
    
    ' Return the distance
    GetDistance = distance
End Function
 
Upvote 0
Superb thanks.

Is there a way I can change the output format, so I can sort the "Time" col in particular smallest to largest etc?

1712760875106.png
 
Upvote 0
Try this for distance
VBA Code:
Function GetDistance(destination As String) As Double
    Dim apiKey As String
    Dim url As String
    Dim responseText As String
    Dim objHTTP As Object
    Dim distance As String
    Dim parts() As String
  
    origin = "WA7 5PS"
    ' Replace "YOUR_API_KEY" with your actual API key
    apiKey = "YOUR_API_KEY"
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & _
            origin & "&destinations=" & destination & "&units=imperial&key=" & apiKey
    ' Send HTTP request to the Distance Matrix API
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", url, False
    objHTTP.send
    responseText = objHTTP.responseText
    ' Parse the JSON response to extract distance
    If InStr(responseText, "OK") > 0 Then
        distance = Split(Split(responseText, """text"" : """)(1), """")(0)
        parts = Split(distance, " ")
    Else
        GetDistance = 0 ' Or any other default value you prefer
        Exit Function
    End If
    ' Return the distance as a numeric value
    If UBound(parts) >= 0 Then
        On Error Resume Next
        GetDistance = CDbl(parts(0))
        On Error GoTo 0
    Else
        GetDistance = 0
    End If
End Function

...and this for duration.
VBA Code:
Function GetDuration(destination As String) As String
    Dim apiKey As String
    Dim url As String
    Dim responseText As String
    Dim objHTTP As Object
    Dim distance As String
  
    origin = "WA7 5PS"
  
    ' Replace "YOUR_API_KEY" with your actual API key
    apiKey = "YOUR_API_KEY"
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & _
            origin & "&destinations=" & destination & "&units=imperial&key=" & apiKey

    ' Send HTTP request to the Distance Matrix API
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", url, False
    objHTTP.send

    responseText = objHTTP.responseText
    ' Parse the JSON response to extract distance
    If InStr(responseText, "OK") > 0 Then
        duration = Split(Split(responseText, """text"" : """)(2), """")(0)
    Else
        duration = "0 hours 0 mins"
    End If
  
    If InStr(duration, "hours") > 0 Then
        hours = Left(duration, InStr(duration, "hours") - 2)
        minutes = Mid(duration, InStr(duration, "hours") + 6, Len(duration) - InStr(duration, "hours") - 9)
    ElseIf InStr(duration, "mins") > 0 Then
        hours = 0
        minutes = Left(duration, InStr(duration, "mins") - 2)
    End If
    
    ' Return the distance=get
    GetDuration = Format(hours, "00") & ":" & Format(minutes, "00")

End Function
 
Upvote 0
Hi, thanks for this, I appreciate its outside the remit of the orig question.

Formatting output works great for Distance (mileage) but for duration I seem to have a couple of anomalies and I dont know why.

At first I thought because google maps (when manually checking) returns "This route has tolls" for the problematic postcodes. Thats the only diff I could see, but one of my successfully outputted postcodes (highlighted green) also returns tolls. So not sure why the red highlighted havent formatted quite right/consistently.
 

Attachments

  • Duration formatting.PNG
    Duration formatting.PNG
    63.4 KB · Views: 17
Upvote 0
It is because I didn't account for when it's "hour" singular instead of "hours". Try this instead.
VBA Code:
Function GetDuration(destination As String) As String
    Dim apiKey As String
    Dim url As String
    Dim responseText As String
    Dim objHTTP As Object
    Dim duration As String
    Dim hours As Integer
    Dim minutes As Integer
    Dim origin As String
   
    origin = "WA7 5PS"
   
    ' Replace "YOUR_API_KEY" with your actual API key
    apiKey = "YOUR_API_KEY"
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & _
    origin & "&destinations=" & destination & "&units=imperial&key=" & apiKey
    ' Send HTTP request to the Distance Matrix API
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", url, False
    objHTTP.send
    responseText = objHTTP.responseText
    ' Parse the JSON response to extract duration
    If InStr(responseText, "OK") > 0 Then
        duration = Split(Split(responseText, """text"" : """)(2), """")(0)
    Else
        duration = "0 hours 0 mins"
    End If
    ' Extract hours and minutes from duration
    Dim parts() As String
    parts = Split(duration, " ")
    Dim i As Integer
    For i = 0 To UBound(parts)
        If IsNumeric(parts(i)) Then
            If UCase(parts(i + 1)) Like "HOUR*" Then
                hours = Val(parts(i))
            ElseIf UCase(parts(i + 1)) Like "MIN*" Then
                minutes = Val(parts(i))
            End If
        End If
    Next i

    ' Return the formatted duration
    GetDuration = Format(hours, "00") & ":" & Format(minutes, "00")
End Function
 
Upvote 0
One thing to note is that these driving durations reflect real-time accounting for weather, traffic conditions, etc... Just like when you're doing a live Google Maps search. So those numbers could change by the hour. Something to consider if that's the desired solution you want.
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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