About

1 Star2 Stars3 Stars4 Stars5 Stars (2 votes, average: 5.00 out of 5)
Loading...
Go back to All Questions Login or Register
Tom
5 Rep. 0 Answers 1 Questions 0 Followers 0 Following 1 Comments

Stats

  • 0 answers, 0 selected
  • 1 questions, 0 solved
  • Member for 1 months, 25 days
  • 201 profile views
  • Last seen February 14, 2017

Reputation

Total 5
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+1
February 2, 2017 Commented Hi, Love this bit of code it has proved really useful so thank you for putting it together. I am however having an unusual issue which i couldn't see anyone else having so 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 code as i have it in Excel.
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
 
+1
February 2, 2017 registration
+1
February 2, 2017 registration

Votes

0 votes received 0/100 0up 0down
0 votes casted 0/100 0up 0down

Top Answers

No answer posted yet!

New questions

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