Distance_Calc_fromString

Calculate distance between two points (Latitude, Longitude)
LatLon1 and LatLon2 can be either Lat,Lon or Lon,Lat
Possible4 is to make sure that function calculates all those possible scenarios
"Lat1,Lon1" + "Lat2,Lon2"
"Lon1,Lat1" + "Lon2,Lat2"
"Lat1,Lon1" + "Lat2,Lon2"
"Lon1,Lat1" + "Lon2,Lat2"
if you sure it is Lat1,Lon1 and Lat2,Lon2, pass Possible4 as 0 to make function faster
Returns meters between those two points, or
-1 if could not read LatLon
0 if exact same LatLon
10k meters if it is more than 10k

CodeFunctionName
What is this?

Public

Tested

Original Work
Function Distance_Calc_fromString(LatLon1, LatLon2, Optional Possible4 = 1)
' Original function from: http://www.movable-type.co.uk/scripts/latlong.html
' Returns -1 if could not read LatLon
' Returns 0 if exact same LatLon
' Returns 10k meters if it is more than 10k
' If Possible4 = 1, function will calculate all 4 possible options of LatLon1, LonLat1, LatLon2 and LonLat2 of distances and return the minimum found
' Needs CutString3
'
RetuN = -1
Lat1 = CutString3(LatLon1, 1, ",")
Lon1 = CutString3(LatLon1, 2, ",")
Lat2 = CutString3(LatLon2, 1, ",")
Lon2 = CutString3(LatLon2, 2, ",")
If Lat1 = "" Or Lon1 = "" Or Lat2 = "" Or Lon2 = "" Then Exit Function
Lat1 = Val(Lat1)
Lon1 = Val(Lon1)
Lat2 = Val(Lat2)
Lon2 = Val(Lon2)
RetuN = 0
If Lat1 = Lat2 And Lon1 = Lon2 Then GoTo ByeBye
Dist1 = 10000
Dist2 = 10000
Dist3 = 10000
Dist4 = 10000
' =ACOS( SIN(lat1*PI()/180)*SIN(lat2*PI()/180) + COS(lat1*PI()/180)*COS(lat2*PI()/180)*COS(lon2*PI()/180-lon1*PI()/180) ) * 6371000
'ShD.Range(CellAdd).FormulaR1C1 = "=ACOS( SIN(" & Lat1 & "*PI()/180)*SIN(" & Lat2 & "*PI()/180) + COS(" & Lat1 & _
On Error Resume Next
Fx1 = WorksheetFunction.Radians(Lat1) ' RADIANS(90" & Oper_Lat1 & Lat1 & ")
Fx2 = WorksheetFunction.Radians(Lat2)
Fx3 = WorksheetFunction.Radians(Lon1)
Fx4 = WorksheetFunction.Radians(Lon2)
Fx5 = WorksheetFunction.Radians(Lon2 - Lon1) ' RADIANS(" & Lon1 & Oper_Lon2 & Lon2 & ")
Fx6 = WorksheetFunction.Radians(Lat2 - Lon2)
Fx7 = WorksheetFunction.Radians(Lon1 - Lat2)
Fx8 = WorksheetFunction.Radians(Lat1 - Lon2)
Fx9 = WorksheetFunction.Radians(Lat1 - Lon1)
Fx10 = WorksheetFunction.Radians(Lat1 - Lat2)
Fx11 = WorksheetFunction.Acos(Sin(Fx1) * Sin(Fx2) + Cos(Fx1) * Cos(Fx2) * Cos(Fx6)) * 6371000
If Err.Number = 0 Then Dist1 = Fx11
Err.Clear
If Possible4 = 0 Then GoTo DirectOut
Dist2 = WorksheetFunction.Acos(Sin(Fx1) * Sin(Fx3) + Cos(Fx1) * Cos(Fx3) * Cos(Fx5)) * 6371000
Dist3 = WorksheetFunction.Acos(Sin(Fx1) * Sin(Fx4) + Cos(Fx1) * Cos(Fx4) * Cos(Fx7)) * 6371000
Dist4 = WorksheetFunction.Acos(Sin(Fx2) * Sin(Fx3) + Cos(Fx2) * Cos(Fx3) * Cos(Fx8)) * 6371000
Dist5 = WorksheetFunction.Acos(Sin(Fx2) * Sin(Fx4) + Cos(Fx2) * Cos(Fx4) * Cos(Fx9)) * 6371000
Dist6 = WorksheetFunction.Acos(Sin(Fx3) * Sin(Fx4) + Cos(Fx3) * Cos(Fx4) * Cos(Fx10)) * 6371000
DirectOut:
RetuN = WorksheetFunction.Min(Dist1, Dist2, Dist3, Dist4, Dist5, Dist6)
ByeBye:
Distance_Calc_fromString = RetuN
End Function

LatLon1, LatLon2, Optional Possible4

Views 3,263

Downloads 1,242

CodeID
DB ID

ANmarAmdeen
610
Attachments
Revisions

v1.0

Wednesday
June
27
2018