Results 1 to 11 of 11

Thread: Distance Calculator between two UK postcodes in excel

  1. #1
    Join Date
    Jun 2011
    Posts
    85

    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.

  2. #2
    Join Date
    May 2009
    Posts
    527

    Re: Distance Calculator between two UK postcodes in excel

    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

  3. #3
    Join Date
    Apr 2009
    Posts
    491

    Re: Distance Calculator between two UK postcodes in excel

    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

  4. #4
    Join Date
    May 2009
    Posts
    542

    Re: Distance Calculator between two UK postcodes in excel

    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

  5. #5
    Join Date
    Apr 2009
    Posts
    570

    Re: Distance Calculator between two UK postcodes in excel

    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;

  6. #6
    Join Date
    May 2009
    Posts
    529

    Re: Distance Calculator between two UK postcodes in excel

    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

  7. #7
    Join Date
    May 2009
    Posts
    640

    Re: Distance Calculator between two UK postcodes in excel

    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

  8. #8
    Join Date
    Aug 2011
    Posts
    1

    Re: Distance Calculator between two UK postcodes in excel

    @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

  9. #9
    Join Date
    Dec 2007
    Posts
    2,297

    Re: Distance Calculator between two UK postcodes in excel

    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.

  10. #10
    Join Date
    Feb 2012
    Posts
    1

    Re: Distance Calculator between two UK postcodes in excel

    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.

  11. #11
    Join Date
    Jun 2006
    Posts
    625

    Re: Distance Calculator between two UK postcodes in excel

    Quote Originally Posted by philipryoung View Post
    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

Similar Threads

  1. Replies: 1
    Last Post: 17-08-2012, 03:23 PM
  2. Replies: 2
    Last Post: 17-02-2012, 04:38 PM
  3. Birthday calculator spreadsheet in excel
    By Yogisa in forum Windows Software
    Replies: 4
    Last Post: 13-07-2011, 09:00 PM
  4. Replace calculator with Command Line Calculator
    By Eric B in forum Windows Software
    Replies: 3
    Last Post: 07-05-2009, 04:32 PM
  5. Replies: 0
    Last Post: 08-12-2008, 04:04 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •