Issue with calculating distance between two coordinates

1 Star2 Stars3 Stars4 Stars5 Stars (3 votes, average: 5.00 out of 5)
Loading...
Go back to All Questions Login or Register
131 views
0

Hi

I am having an unusual issue with a piece of code i go from another section of the site for which i couldn’t see anyone else having in the comments section. Hoping someone can point out maybe what might be causing it.

The problem is that when I use the code to calculate the direct distance between two coordinates when based in the UK I get one sensible number but when I go abroad and use it in some countries I get a total different unrelated number.

e.g. Distance between London, UK and Brussels, Belgium

When in the UK distance = 313km

When in Belgium = 16269km

Any suggestions would be appreciated

Here is the link source http://analystcave.com/excel-calculate-distances-between-addresses/

And here is the code i am using in my file:

Public Function GetDistanceCoord(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
Dim theta As Double: theta = lon1 – lon2
Dim dist As Double: dist = Math.Sin(deg2rad(lat1)) * Math.Sin(deg2rad(lat2)) + Math.Cos(deg2rad(lat1)) * Math.Cos(deg2rad(lat2)) * Math.Cos(deg2rad(theta))
dist = WorksheetFunction.Acos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
If unit = “K” Then
dist = dist * 1.609344
ElseIf unit = “N” Then
dist = dist * 0.8684
End If
GetDistanceCoord = dist
End Function

Function deg2rad(ByVal deg As Double) As Double
deg2rad = (deg * WorksheetFunction.Pi / 180#)
End Function

Function rad2deg(ByVal rad As Double) As Double
rad2deg = (rad / WorksheetFunction.Pi * 180#)
End Function

Sub GetLocation(address As String, ByRef lat As String, ByRef lng As String)
Dim FirstVal As String, secondVal As String, lastVal As String
FirstVal = “https://maps.googleapis.com/maps/api/geocode/json?address=”
lastVal = “&region=uk&language=en&sensor=false”
Set objHTTP = CreateObject(“MSXML2.ServerXMLHTTP”)
URL = FirstVal & Replace(address, ” “, “+”) & lastVal
objHTTP.Open “GET”, URL, False
objHTTP.setRequestHeader “User-Agent”, “Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)”
objHTTP.send (“”)
If InStr(objHTTP.responseText, “””lat”””) = 0 Then GoTo ErrorHandl
tmpVal = Right(objHTTP.responseText, Len(objHTTP.responseText) – InStr(objHTTP.responseText, “””lat”” : “) – 7)
lat = Split(tmpVal, “,”)(0)
tmpVal = Right(objHTTP.responseText, Len(objHTTP.responseText) – InStr(objHTTP.responseText, “””lng”” : “) – 7)
lng = Replace(Split(tmpVal, “}”)(0), ” “, “”)
Exit Sub
ErrorHandl:
lat = lng = 0
End Sub

Simply the best place to learn VBA!

Error: Please enter a valid email address

Error: Invalid email

Error: Please enter your first name

Error: Please enter your last name

Error: Please enter a username

Error: Please enter a password

Error: Please confirm your password

Error: Password and password confirmation do not match