Calculate distance between 2 postcode

[gazmoz17]

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

 

[gazmoz17]

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

 

[Cubist]

Using Google API you should able to search more than zipcodes. See example below. Try this.

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
	A	B	C	D
1	Origin	Destination	Distance
2	Dallas, Texas	Irving, California	1,421 mi
3	OX14 5PB	WA7 5PS	167 mi
4	RG8 7JF	WA7 5PS	186 mi
5
Sheet1

Cell Formulas
Range	Formula
C2:C4	C2	=GetDistance(A2,B2)

 

[gazmoz17]

Wow thanks for this cubist . I’ll have a look in work tomorrow thank you, much appreciated

 

[gazmoz17]

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

 

[Cubist]

Thanks for the feedback. To return the driving time, change 1 to 2 on this line.

distance = Split(Split(responseText, """text"" : """)(1), """")(0)

If you want km instead of miles, change "imperial" to "metric" on this line.

    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.

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

 

[gazmoz17]

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?

 

[Cubist]

Try this for distance

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.

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

 

[gazmoz17]

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.

 

[Cubist]

It is because I didn't account for when it's "hour" singular instead of "hours". Try this instead.

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

 

[Cubist]

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.