Jim,
If you Googled the Excel groups for
Bearing Latitude Longitude
and you would have found the functions below....
HTH,
Bernie
MS Excel MVP
'Functions by Andy Dulavitz (
[email protected])
'Formulas as per Bowditch - The American Practical Navigator.
Public Function MercatorCse(Lat1, Lon1, Lat2, Lon2 As Double)
' Lat1, Lon1 - lat and lon for position 1
' Lat2, Lon2 - lat and lon for position 2
' Returns Course in degrees by mercator sailing
' from position 1 to position 2
' Assumes input is North = + , East = +
' Declare Variables
Dim l As Double
Dim Dlo As Double
Dim NS As String
Dim EW As String
Dim m1 As Double
Dim m2 As Double
Dim m As Double
Dim Lon1Sin As String
Dim Lon2Sin As String
Dim LongIndicator As String
' Determine if Cse is due north or due south
If (Lon1 = Lon2) Then
If (Lat1 < Lat2) Then
Bearing = 0#
Else
Bearing = 180#
End If
' If Bearing is either due N or due S then go straight to end
GoTo SkipCalcs
' If not then we continue on with calculations
Else
' Assign E/W Direction Sign for Lon1 and Lon2
If Lon1 < 0 Then
Lon1Sin = "W"
Else
Lon1Sin = "E"
End If
If Lon2 < 0 Then
Lon2Sin = "W"
Else
Lon2Sin = "E"
End If
' Convert Longitudes to absolute numbers
Lon1 = Application.WorksheetFunction.Fixed(Abs(Lon1))
Lon2 = Application.WorksheetFunction.Fixed(Abs(Lon2))
' DETERMINE which of 4 cases we have for longitude, and
' CALCULATE Dlo and DETERMINE E/W componant of Cse Angle
LongIndicator = Lon1Sin & Lon2Sin
Select Case LongIndicator
Case "EW"
Dlo = Lon1 + Lon2
If Dlo > 180 Then
Dlo = 360 - Dlo
EW = "E"
Else
EW = "W"
End If
Case "WE"
Dlo = Lon1 + Lon2
If Dlo > 180 Then
Dlo = 360 - Dlo
EW = "W"
Else
EW = "E"
End If
Case "WW"
If Lon2 > Lon1 Then
Dlo = Lon2 - Lon1
EW = "W"
Else
Dlo = Lon1 - Lon2
EW = "E"
End If
Case "EE"
If Lon2 > Lon1 Then
Dlo = Lon2 - Lon1
EW = "E"
Else
Dlo = Lon1 - Lon2
EW = "W"
End If
End Select
' Multiply Dlo by 60 for use in further Calculations
Dlo = Dlo * 60
' CALCULATE MERIDIONAL PARTS:
' CALCULATION NOTES..........
' Formula for meridional parts is
' m = 7915.7 Log Tan (45 + (Lat/2) - 23 * Sin(Lat)
' Used a constant value of 0.017453 for converting degrees to Radians.
' Used a constant of 0.785398 for 45 in Radians
' Must divide Log of number by Log(10).
' Example: Log(Number) / Log(10)
m1 = 7915.7 * Log(Tan(0.785398163 + (Lat1 / 2) * 0.017453293)) / _
Log(10) - (Sin(Lat1 * 0.017453293) * 23)
m2 = 7915.7 * Log(Tan(0.785398163 + (Lat2 / 2) * 0.017453293)) / _
Log(10) - (Sin(Lat2 * 0.017453293) * 23)
m = m1 - m2
m = Application.WorksheetFunction.Fixed(Abs(m))
' CALCULATE COURSE ANGLE:
' The formula from Bowditch is ... Tan C = Dlo/m
If Lat1 = Lat2 Then
CseAngle = 90
GoTo Skip3
End If
CseAngle = (Dlo * 0.07453) / (m * 0.07453)
CseAngle = Atn(CseAngle)
' Convert to degrees
CseAngle = Application.WorksheetFunction.Degrees(CseAngle)
Skip3:
' Set Decimal places to 1
CseAngle = Application.WorksheetFunction.Fixed(CseAngle, 1)
' Make it a postive number so that the math works properly
CseAngle = Abs(CseAngle)
'________________________________________________________________
'
' NOTE: Had to use Worksheet Functions for DEGREES and FIXED as
' VBA does not have an equivilant
'________________________________________________________________
'
' CALCULATE THE COURSE ANGLE:
' Determine if North or South
If Lat2 > Lat1 Then
NS = "N"
Else
NS = "S"
End If
' Determine how to apply the course angle
If NS = "N" And EW = "E" Then
Bearing = 0 + CseAngle
End If
If NS = "S" And EW = "E" Then
Bearing = 180 - CseAngle
End If
If NS = "N" And EW = "W" Then
Bearing = 360 - CseAngle
End If
If NS = "S" And EW = "W" Then
Bearing = 180 + CseAngle
End If
' FINALLY WE OUTPUT THE RESULT:
End If
SkipCalcs:
MercatorCse = Bearing
Exit Function
End Function
Public Function MercatorDist(Lat1, Lon1, Lat2, Lon2, Cse)
Select Case Cse
Case 90
Dlo = Lon1 - Lon2
MercatorDist = Dlo * 60 * Cos(Lat1 * 0.017453)
Case 270
Dlo = Lon1 - Lon2
MercatorDist = Dlo * 60 * Cos(Lat1 * 0.017453)
Case 0
MercatorDist = Abs((Lat1 - Lat2) * 60)
Case 180
MercatorDist = Abs((Lat1 - Lat2) * 60)
Case Else
Rcse = 0.017453 * Cse
l = Abs((Lat1 - Lat2) * 0.017453)
MercatorDist = l / Cos(Rcse)
MercatorDist = Application.WorksheetFunction.Degrees(MercatorDist)
MercatorDist = Abs(MercatorDist) * 60
End Select
End Function
