Distance Calculator between two UK postcodes in excel

Recently I am interested for having an Excel Spread sheet that calculates distance between two UK postcodes. The distance between two UK postcodes should be in a straight line. Can it be done? If yes then it would be very helpful for me to do my work. All your reply will be appreciated. I am eagerly waiting for your reply.

Yes it is possible if you try. I have some suggestions for you, below is the sample code for you which I have edited or you can say modified as per your needs. It is modified to work down the sheet when in column A there is starting postcodes and the finish postcodes are in column B including the mileage results in column C.

Code:

---

Private Sub CommandButton1_Click()
counter = 6

beginrange = Worksheets("sheet1").Cells(counter, 4).Address
endrange = Worksheets("sheet1").Cells(counter, 14).Address


For Each c In Worksheets("Sheet1").Range(beginrange, endrange).Cells
If c.Offset(0, 1).Value = "" Then counter = counter + 2
If counter = 20 Then Exit Sub
beginrange = Worksheets("sheet1").Cells(counter, 4).Address
endrange = Worksheets("sheet1").Cells(counter, 14).Address

---

I would be glad to add more function to the above code since its incomplete but correct. It will set the Internet Explorer browser URL for you. The remaining code is as follows:

Code:

---

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URL =
"http://www.postcode.org.uk/country/uk/_postcode-distance-calculator.asp"
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop
Do While IE.busy = True
DoEvents
Loop

---

Including the Internet Explorer browser you also have to set the Internet Explorer document form to add postcodes to their specific address fields. Just refer the below code and extract all the help you need from it.

Code:

---

Set Form = IE.document.getElementsByTagname("Form")
Set inputform = Form.Item(0)

Set Postcodebox = inputform.Item(0)
Postcodebox.Value = c.Value

Set Postcodebox2 = inputform.Item(1)
Postcodebox2.Value = c.Offset(0, 1).Value

Set POSTCODEbutton = inputform.Item(2)
POSTCODEbutton.Click

Do While IE.busy = True
Loop

Set Table = IE.document.getElementsByTagname("Table")
Set DistanceTable = Table.Item(3)

Set DistanceRow = DistanceTable.Rows(2)
distance = Val(Trim(DistanceRow.Cells(2).innertext))

c.Offset(1, 1).Value = distance
IE.Quit
Next

End Sub

---

To calculate the distance between two postcodes of UK in two specific addresses you need a formula. The formula name is Haversine Formula that you have to use in the module.

• a = sin²(Δlat/2) + cos(lat1).cos(lat2).sin²(Δlong/2)
• c = 2.atan2(√a, √(1−a))
• d = R.c
  Here R is earth’s radius (radius = 6,371km);

Also you have to follow the below Script with the above:

Code:

---

var R = 6371; // km
var dLat = (lat2-lat1).toRad();
var dLon = (lon2-lon1).toRad();
var lat1 = lat1.toRad();
var lat2 = lat2.toRad();

var a = Math.sin(dLat/2) * Math.sin(dLat/2) +
        Math.sin(dLon/2) * Math.sin(dLon/2) * Math.cos(lat1) * Math.cos(lat2);
var c = 2 * Math.atan2(Math.sqrt(a), Math.sqrt(1-a));
var d = R * c;

---

Copy paste and store the below vba in the actual standard module but I am not sure how to add the mileage using the formula.

Code:

---

Public Function getGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
    Dim sURL As String
    Dim BodyTxt As String
    Dim vUnits As Variant
    Dim dblTemp As Double
    Dim bUnit As Byte
    sURL = "http://maps.google.com/maps?f=d&source=s_d"
        sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
        sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
        sURL = sURL & "&hl=en"
    BodyTxt = getHTML(sURL)
    If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
        getGoogDistanceTime = "Error"
    Else
        getGoogDistanceTime = parseGoog(strReturn, BodyTxt)
        If LCase(strReturn) Like "time*" Then
            vUnits = Split(getGoogDistanceTime)
            For bUnit = LBound(vUnits) To UBound(vUnits) - 1 Step 2
                dblTemp = dblTemp + _
                        Val(vUnits(bUnit)) / Choose(InStr(1, "hms", Left(vUnits(bUnit + 1), 1), vbTextCompare), 24, 1440, 86400)
            Next bUnit
            getGoogDistanceTime = dblTemp
        Else
            getGoogDistanceTime = Val(getGoogDistanceTime)
        End If
    End If
End Function

Public Function getHTML(strURL As String) As String
    Dim oXH As Object
    Set oXH = CreateObject("msxml2.xmlhttp")
    With oXH
        .Open "get", strURL, False
        .send
        getHTML = .responseText
    End With
    Set oXH = Nothing
End Function

Public Function parseGoog(strSearch As String, strHTML As String) As String
    strSearch = strSearch & ":"""
    If InStr(1, strHTML, strSearch) = 0 Then
        parseGoog = "Not Found"
        Exit Function
    Else
        parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
        parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, """") - 1)
    End If
End Function

---

I think I can help you with the mileage using a formula along the lines. Its very easy and will work fine. I am sure because I have personally tried it.
C1:

Code:

---

=GetGoogDistanceTime(A1,B1,"distance")

---

Here A1 holds the start post code while the B1 is the destination post code

For the estimated Travel Time use the following:
D1:

Code:

---

=GetGoogDistanceTime(A1,B1,"time")

---

format cell as [h]:mm:ss

@Author and Steyn - that is brilliant chaps, just what I needed!

I had to change one line of Author's code

Code:

---

strSearch = strSearch & ":"""

---

to

Code:

---

strSearch = strSearch & ":'"

---

and heh presto

One question and one problem though, I can't seem to get the Time parameter working, it just gives me the usual #value error

and what does the "distance" parameter actually do since my result doesn't appear any different without the option (just curious)

Cheers again
Squeaks

Actually, excels sees Times as decimal fractions, with 1 being the time 24:00 or 00:00. 18:00 has true value of 0.75 because it is three quarters of 24 hours, or the whole number 1. To see the true value of a date and/or time simply format the cell as "General". For example the date and time 3/July/2002 3:00:00 PM has a true value of 37440.625 with the number after the decimal representing the time and the 37440 being the serial value for 3/July/2002.

Hello,

I have tried using this code and I get a #NAME? error in the cell I have put the formula in.

Thanks in advance for the help.

Phil.

Quote:

---

Originally Posted by philipryoung

Hello,

I have tried using this code and I get a #NAME? error in the cell I have put the formula in.

---

You can code wise store the below in a standard module in VBE:

Code:

---

Public Function getGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
    Dim sURL As String
    Dim BodyTxt As String
    Dim vUnits As Variant
    Dim dblTemp As Double
    Dim bUnit As Byte
    sURL = "http://maps.google.com/maps?f=d&source=s_d"
        sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
        sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
        sURL = sURL & "&hl=en"
    BodyTxt = getHTML(sURL)
    If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
        getGoogDistanceTime = "Error"
    Else
        getGoogDistanceTime = parseGoog(strReturn, BodyTxt)
        If LCase(strReturn) Like "time*" Then
            vUnits = Split(getGoogDistanceTime)
            For bUnit = LBound(vUnits) To UBound(vUnits) - 1 Step 2
                dblTemp = dblTemp + _
                        Val(vUnits(bUnit)) / Choose(InStr(1, "hms", Left(vUnits(bUnit + 1), 1), vbTextCompare), 24, 1440, 86400)
            Next bUnit
            getGoogDistanceTime = dblTemp
        Else
            getGoogDistanceTime = Val(getGoogDistanceTime)
        End If
    End If
End Function

Public Function getHTML(strURL As String) As String
    Dim oXH As Object
    Set oXH = CreateObject("msxml2.xmlhttp")
    With oXH
        .Open "get", strURL, False
        .send
        getHTML = .responseText
    End With
    Set oXH = Nothing
End Function

---