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

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 366 Downloads 137

'CutString3', 'distance', 'route', 'directions', 'earth', 'map', 'globe', 'points'

ANmarAmdeen
324
Attachments
Math VBA-Excel
Revisions

v1.0