Results 1 to 11 of 11
  1. #1
    Salty Mariner is offline Intermediate
    Windows 11 Access 2021
    Join Date
    Dec 2023
    Location
    Corpus Christi, TX
    Posts
    57

    My Latitude and Longitude Subs and Functions

    For anyone who is interested I'm sharing my latitude and Longitude Subroutines and functions. I wrote this over 20 years ago when I was first learning VBA. Since my occupation is a professional mariner I wanted to build some vba that could be used in navigation applications. I first built a voyage planning Application in Excel and later built a voyage planning application using Access. I wrote string subroutines to validate Latitude and longitude to see that say Latitude Degrees did not exceed 90 degrees, Longitude degrees did not exceed 180 Minutes did not exceed 59.999, and that a valid quadrant indicator was present (N, S, E, W) I wanted users to be able to type in Latitudes and longitudes in the same way that they would write them down. After the string was validated I had string functions to break apart and convert the Lat/Lon string to decimal degrees for use in navigational calculations and making it positive or negative (South = Negative, West = Negative).



    Finally there are calculations for determining course and distance by Mercator sailing using the formulas from The American Practical Navigator (Bowditch) This required a lot of logic to determine course angle and difference of Longitude. Angles had to be computed in Radians so I had a couple of functions to convert back and forth. the formula from Bowditch also used Logarithm's. It's a lot of code and I wrote this while studying with the VBA for Dummies as my primary reference. There is a Function for Mercator Distance as well. Everything works too as I tested against several other calculation methods.

    Finally I have 2 functions for converting decimal Degrees back to strings formatted as 00-00.000N (include leading and trailing zeros) for latitude, and 000-00.000N (include leading and trailing zeros) for Longitude.

    I never got around to adding other calculation methods (such as Great Circle) but I think there is VBA code out there now that does this.

    I was just learning when I wrote this so perhaps the code could be more streamlined but since it works I'm not really inclined to do so.

    Use or modify as you see fit.

    Code:
    Option Compare Database
    Option Explicit
    
    Public Const Pi As Double = 3.14159265358979
    Public Function DegreesToRadians(dblDegrees As Double)
        DegreesToRadians = dblDegrees * (Pi / 180)
    End Function
    
    Public Function RadiansToDegrees(dblRadians As Double)
        RadiansToDegrees = dblRadians * (180 / Pi)
    End Function
    
    
    
    
    '------------------------------------------------------------
    ' NAME: ValidateLatitude()
    ' PORPOSE: Validates Latititude entered as a string to ensure
    ' it is properly structured for use in navigation calculations
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: Feb 2002 (Excel) Revised for Access August 2023
    '-------------------------------------------------------------
    Public Sub ValidateLatitude(strLatValue As String)
    On Error GoTo ValidateLatitude_Err
    
    
    Dim strLatDegrees As String
    Dim strLatMinutes As String
    Dim strLatDirection As String
    Dim strSeparator As String
    Dim dblLatDeg As Double
    Dim arrDirection As Variant
    Dim intNumCount As Integer
    Dim i As Integer
    Dim booFoundMatch As Boolean
    Dim strMsg As String
    Dim booNonNumeric As Boolean
    
    
        ' Check for Null value, if so Exit Sub
        If strLatValue = "" Then
            TempVars("CancelUpdate") = "True"
            Exit Sub
        End If
        
        ' Set CancelUpdate to False as default
        TempVars("CancelUpdate") = "False"
        
        'Set nonNumeric to False as default
        booNonNumeric = False
        
        ' Fill Array
        arrDirection = Array("N", "S", "E", "W")
        
        ' Initialize Counter
        intNumCount = 0
    
    
    
    
    
    
        ' Get rid of leading or trailing blanks
        strLatValue = Trim(strLatValue)
        ' assign value to direction variable
        strLatDirection = Right(strLatValue, 1)
    
    
    
    
    '''''' Get values for degrees and minutes''''''
        
        ' searches for "-" or " " (space or dash)
        If InStr(strLatValue, "-") > 0 Then
            strSeparator = "-"
        ElseIf InStr(strLatValue, " ") > 0 Then
            strSeparator = " "
        Else
            'Warn user and cancel Update
            MsgBox "No dash separator for Degrees/Minutes" & vbCrLf & "Please try again.", vbOKOnly + vbInformation, "Missing separator"
            TempVars("CancelUpdate") = "True"  ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
         
        ' Assign Latitude degrees and minutes to variables
        strLatDegrees = Left(strLatValue, InStr(strLatValue, strSeparator) - 1)
        
        ' Check to see if user entered a non-numeric character in place of a number
        If Not IsNumeric(strLatDegrees) Then booNonNumeric = True
        
        strLatMinutes = Left(Right(strLatValue, Len(strLatValue) - InStr(strLatValue, strSeparator)), _
            Len(Right(strLatValue, Len(strLatValue) - InStr(strLatValue, strSeparator))))
            
        ' strip direction
        strLatMinutes = Left(strLatMinutes, Len(strLatMinutes) - 1)
        
        ' Check to see if user entered a non-numeric character in place of a number
        If Not IsNumeric(strLatMinutes) Then booNonNumeric = True
        
        ' Warn user, cancel update, and exit
        If booNonNumeric = True Then
            MsgBox "You enetered a non-numeric charactor in place of a number" & vbCrLf & "Please Correct", vbOKOnly + vbExclamation, "Invalid entry"
            TempVars("CancelUpdate") = "True"
            Exit Sub
        End If
        
    
    
    
    
    ' ------------------------------------------------------
    ' ---------------VALIDATION FOR LATITUDES---------------
    ' ------------------------------------------------------
    
    
    ' Set Initial Match Value and Check for direction sign
    
    
        booFoundMatch = True
    
    
        For i = 0 To 1  ' We only need to check the 1st two array elements ("N" or "S")
                If strLatDirection = arrDirection(i) Then
                    booFoundMatch = True
                    GoTo NEXTCHECK
                Else
                    booFoundMatch = False
                End If
        Next i
    
    
    ' Display message if no direction sign.
    
    
        If booFoundMatch = False Then ' Build a message
            strMsg = "The latitude you entered must have" & vbCrLf
            strMsg = strMsg & "a valid N/S direction indicator "
            strMsg = strMsg & vbCrLf & vbCrLf & "Please try again!"
        ' Warn user and cancel update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
            End If
    
    
    NEXTCHECK:
    
    
        ' Validate Degrees
        If Val(strLatDegrees) > 90 Then
            '     Build a message
            strMsg = "The latitude can not exceed 90 degrees "
            strMsg = strMsg & vbCrLf & "Please try again!"
            
            ' Warn user and Cancel Update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
        
        
        ' Validate Minutes
        If Val(strLatMinutes) > 59.9999 Then
            '     Build a message
            strMsg = "The latitude minutes cannot exceed 59.999"
            strMsg = strMsg & vbCrLf & "Please try again!"
            
            ' Warn user and Cancel Update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
        
        ' Finally we combine degrees and minutes and
        ' check that the total does not exceed 90
        dblLatDeg = Format(CDbl((Val(strLatDegrees) + Val(strLatMinutes) / 60)), "00.0000")
        
        If dblLatDeg > 90 Then
         '     Build a message
            strMsg = "The latitude degrees and minuntes" & vbCrLf
            strMsg = strMsg & "can not exceed a total of 90 degrees"
            strMsg = strMsg & vbCrLf & "Please try again!"
        ' Warn user
            MsgBox strMsg, vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"  ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
        
        
    ValidateLatitude_Exit:
        Exit Sub
    
    
    ValidateLatitude_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume ValidateLatitude_Exit
        
    End Sub
    
    
    '------------------------------------------------------------
    ' NAME: ValidateLongitude()
    ' PORPOSE: Validates Longitude entered as a string to ensure
    ' it is properly structured for use in navigation calculations
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: Feb 2002 (Excel) Revised for Access August 2023
    '-------------------------------------------------------------
    Public Sub ValidateLongitude(strLonValue As String)
    On Error GoTo ValidateLongitude_Err
    
    
    Dim strLonDegrees As String
    Dim strLonMinutes As String
    Dim strLonDirection As String
    Dim strSeparator As String
    Dim dblLonDeg As Double
    Dim arrDirection As Variant
    Dim intNumCount As Integer
    Dim i As Integer
    Dim booFoundMatch As Boolean
    Dim strMsg As String
    Dim f As String
    Dim booNonNumeric As Boolean
    
    
        ' Check for Null value, if so Exit Sub
        If strLonValue = "" Then
            TempVars("CancelUpdate") = "True"
            Exit Sub
        End If
        
        ' Set CancelUpdate to False as default
        TempVars("CancelUpdate") = "False"
        
        
        ' Fill Array
        arrDirection = Array("N", "S", "E", "W")
        
        ' Initialize Counter
        intNumCount = 0
    
    
    
    
        ' Get rid of leading or trailing blanks
        strLonValue = Trim(strLonValue)
        ' assign value to direction variable
        strLonDirection = Right(strLonValue, 1)
            
    
    
    '''''' Get values for degrees and minutes''''''
        
        ' searches for "-" or " " (space or dash)
        If InStr(strLonValue, "-") > 0 Then
            strSeparator = "-"
        ElseIf InStr(strLonValue, " ") > 0 Then
            strSeparator = " "
        Else
            'Warn user and cancel Update
            MsgBox "No dash separator for Degrees/Minutes" & vbCrLf & "Please try again.", vbOKOnly + vbExclamation, "Missing Separator"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
    
    
        ' Assign Longitude degrees and minutes to variables
        strLonDegrees = Left(strLonValue, InStr(strLonValue, strSeparator) - 1)
        
        'Check to see if user entered a non-numeric character in place of a number
        If Not IsNumeric(strLonDegrees) Then booNonNumeric = True
        
        strLonMinutes = Left(Right(strLonValue, Len(strLonValue) - InStr(strLonValue, strSeparator)), _
            Len(Right(strLonValue, Len(strLonValue) - InStr(strLonValue, strSeparator))))
            
        ' strip direction
        strLonMinutes = Left(strLonMinutes, Len(strLonMinutes) - 1)
            
        ' Check to see if user entered a non-numeric character in place of a number
        If Not IsNumeric(strLonMinutes) Then booNonNumeric = True
            
        ' Warn user, cancel update, and exit
        If booNonNumeric = True Then
            MsgBox "You enetered a non-numeric charactor in place of a number" & vbCrLf & "Please Correct", vbOKOnly + vbExclamation, "Invalid entry"
            TempVars("CancelUpdate") = "True"
            Exit Sub
        End If
            
    
    
    
    
    ' ------------------------------------------------------
    ' ---------------VALIDATION FOR LONGITUDE---------------
    ' ------------------------------------------------------
    
    
    ' Set Initial Match Value and Check for direction sign
    
    
        booFoundMatch = True
    
    
        For i = 2 To 3  ' We only need to check the 1st two array elements ("E" or "W")
                If strLonDirection = arrDirection(i) Then
                    booFoundMatch = True
                    GoTo NEXTCHECK
                Else
                    booFoundMatch = False
                End If
        Next i
    
    
    ' Display message if no direction sign.
    
    
        If booFoundMatch = False Then ' Build a message
            strMsg = "The Longitude you entered must have" & vbCrLf
            strMsg = strMsg & "a valid E/W direction indicator "
            strMsg = strMsg & vbCrLf & vbCrLf & "Please try again!"
        ' Warn user and cancel update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"  ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
            End If
    
    
    NEXTCHECK:
    
    
        ' Validate Degrees
        If Val(strLonDegrees) > 180 Then
            '     Build a message
            strMsg = "The longitude cannot exceed 180 degrees"
            strMsg = strMsg & vbCrLf & "Please try again!"
            
            ' Warn user and Cancel Update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
        
        
        ' Validate Minutes
        If Val(strLonMinutes) > 59.9999 Then
            '     Build a message
            strMsg = "The longitude minutes cannot exceed 59.999"
            strMsg = strMsg & vbCrLf & vbCrLf & "Please try again!"
            
            ' Warn user and Cancel Update
            MsgBox strMsg, vbOKOnly + vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
        
        ' Finally we combine degrees and minutes and
        ' check that the total does not exceed 90
        dblLonDeg = Format(CDbl((Val(strLonDegrees) + Val(strLonMinutes) / 60)), "00.0000")
        
        If dblLonDeg > 180 Then
         '     Build a message
            strMsg = "The longitude degrees and minuntes " & vbCrLf
            strMsg = "Cannot exceed a total of 90 degrees"
            strMsg = strMsg & vbCrLf & "Please try again!"
        ' Warn user
            MsgBox strMsg, vbExclamation, "Data Entry Error"
            TempVars("CancelUpdate") = "True"   ' Check this TempVars in the BeforeUpdate event that called this subroutine
            Exit Sub
        End If
    
    
    
    
    ValidateLongitude_Exit:
        Exit Sub
    
    
    ValidateLongitude_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume ValidateLongitude_Exit
    
    
    End Sub
    
    
    '------------------------------------------------------------
    ' NAME: Function LatLonToDegs()
    ' PORPOSE: Convert latitude or longitude entered as a string
    ' into decimal degrees for use in navigational calculations
    ' Depends on the ValidateLatitude or ValidateLogitude subroutine
    ' to insure that the string is entered in the proper format
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: Feb 2002 (Excel) Revised for Access August 2023
    '-------------------------------------------------------------
    Public Function LatLonToDegs(strCoordinate As String) As Double
    On Error GoTo LatLonToDegs_Err
    
    
    Dim strCoords As String
    Dim strDirec As String
    Dim intNegativeDirection As Integer
    Dim dblHaveDegrees As Double
    Dim dblHaveMinutes As Double
    Dim dblMyVal As Double
    Dim strMyCell As String
    Dim booNonNumeric As Boolean
    
    
    TempVars("CancelUpdate") = "False"
    
    
    ' Multiplier variable is positive for North Latitude and East Longitude
    intNegativeDirection = 1
    
    
        ' If string is null then set TempVars("CancelUpdate") to False and Exit
        If IsNull(strCoordinate) Then
            MsgBox "No Coodinate provided." & vbCrLf & "Exiting...", vbOKOnly + vbCritical, "Missing Coordinates"
            TempVars("CancelUpdate") = "True"
            Exit Function
        End If
        
    
    
        ' Get rid of leading or trailing blanks and asign a N/S/E/W direction to variable
        strCoords = Trim(strCoordinate)
        strDirec = Right(strCoords, 1)
    
    
        ' Multiplier variable for Latitude/Longitude sign
        ' Latitude is South (-1)
        If strDirec = "S" Then
            intNegativeDirection = -1
        End If
    
    
        'Longitude is West (-1)
        If strDirec = "W" Then
            intNegativeDirection = -1
        End If
    
    
    
    
        'strip direction
        strCoords = Left(strCoords, Len(strCoords) - 1)
    
    
    
    
        'searches for "-"
        If InStr(strCoords, "-") > 0 Then
    
    
            dblHaveDegrees = Left(strCoords, InStr(strCoords, "-") - 1)
            dblHaveMinutes = Left(Right(strCoords, Len(strCoords) - InStr(strCoords, "-")), _
                Len(Right(strCoords, Len(strCoords) - InStr(strCoords, "-"))))
    
    
        'searches for " " Space
        ElseIf InStr(strCoords, " ") > 0 Then
    
    
            dblHaveDegrees = Left(strCoords, InStr(strCoords, " ") - 1)
            dblHaveMinutes = Left(Right(strCoords, Len(strCoords) - InStr(strCoords, " ")), _
                Len(Right(strCoords, Len(strCoords) - InStr(strCoords, " "))))
    
    
        End If
    
    
    ' Finally add Degrees and Decimal Portion and output result
        LatLonToDegs = (dblHaveDegrees + dblHaveMinutes / 60) * intNegativeDirection
    
    
    LatLonToDegs_Exit:
        Exit Function
    
    
    LatLonToDegs_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume LatLonToDegs_Exit
    
    
    End Function
    
    
    
    
    '-------------------------------------------------------------------
    ' NAME: Function MercatorCse()
    ' PORPOSE: Returns course in degress by Mercator Sailing
    ' Lat1, Lon1 - lat and lon for position 1
    ' Lat2, Lon2 - lat and lon for position 2
    ' Assumes input is North = + , East = +
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: Feb 2002 (Excel) Revised for Access August 2023
    ' original formulas from The American Practical Navigator (Bowditch)
    '--------------------------------------------------------------------
    Public Function MercatorCse(Lat1 As Double, Lon1 As Double, Lat2 As Double, Lon2 As Double)
    On Error GoTo MercatorCse_Err
    
    
    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
    Dim Bearing As Double
    Dim CseAngle As Double
    
    
    
    
    ' 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 = Abs(Lon1)
        Lon2 = 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"   ' Going from East to West Longitude
                
            Dlo = Lon1 + Lon2
                
            If Dlo > 180 Then   ' If Dlo exceeds 180 degrees it is shorter to go East
                Dlo = 360 - Dlo
                EW = "E"
            Else
                EW = "W"    'Otherwise we go west
            End If
            
        Case "WE"   'Going from West to East Longitude
                
            Dlo = Lon1 + Lon2
                
            If Dlo > 180 Then   ' If Dlo exceeds 180 degrees it is shorter to go West
                Dlo = 360 - Dlo
                EW = "W"
            Else
                EW = "E"    'Otherwise we go west
            End If
                
        Case "WW"   ' We stay in West Longitude
            If Lon2 > Lon1 Then
                Dlo = Lon2 - Lon1
                EW = "W"    ' We are proceeding in a Westerly direction
            Else
                Dlo = Lon1 - Lon2
                EW = "E"    ' We are proceeding in a Easterly direction
            End If
                
        Case "EE"   ' We stay in East Longitude
            If Lon2 > Lon1 Then
                Dlo = Lon2 - Lon1
                EW = "E"    ' We are proceeding in a Easterly direction
            Else
                Dlo = Lon1 - Lon2
                EW = "W"    ' We are proceeding in a Westerly direction
            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) - (Sin(Lat) * 23)
    ' Used a constant value of 0.017453293 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 = 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 = RadiansToDegrees(CseAngle)
    Skip3:
        ' Set Decimal places to 1
        CseAngle = Round(CseAngle, 1)
        ' Make it a postive number so that the math works properly
        CseAngle = Abs(CseAngle)
    
    
    ' 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
    ElseIf NS = "S" And EW = "E" Then
        Bearing = 180 - CseAngle
    ElseIf NS = "N" And EW = "W" Then
        Bearing = 360 - CseAngle
    ElseIf NS = "S" And EW = "W" Then
        Bearing = 180 + CseAngle
    End If
    
    
    ' FINALLY WE OUTPUT THE RESULT:
    
    
    End If
    SkipCalcs:
    MercatorCse = Bearing
    
    
    MercatorCse_Exit:
        Exit Function
    
    
    MercatorCse_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume MercatorCse_Exit
    
    
    End Function
    '-------------------------------------------------------------------
    ' NAME: Function MercatorDist()
    ' PORPOSE: Returns Distance in nautical miles by Mercator Sailing
    ' Lat1, Lon1 - lat and lon for position 1
    ' Lat2, Lon2 - lat and lon for position 2
    ' Course as calculated prior in Function MercatoCse()
    ' Assumes input is North = + , East = +
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: Feb 2002 (Excel) Revised for Access August 2023
    ' original formulas from The American Practical Navigator (Bowditch)
    '--------------------------------------------------------------------
    Public Function MercatorDist(Lat1 As Double, Lon1 As Double, Lat2 As Double, Lon2 As Double, Cse As Double) As Double
    On Error GoTo MercatorDist_Err
    
    
    Dim Lon1Sin As String
    Dim Lon2Sin As String
    Dim LongIndicator As String
    Dim Dlo As Double
    Dim l As Double
    Dim RadCse As Double
    Dim Dist As Double
    
    
    ' 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 = Abs(Lon1)
        Lon2 = 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
            End If
            
        Case "WE"
                
            Dlo = Lon1 + Lon2
                
            If Dlo > 180 Then
                Dlo = 360 - Dlo
            End If
                
        Case "WW"
            If Lon2 > Lon1 Then
                Dlo = Lon2 - Lon1
            Else
                Dlo = Lon1 - Lon2
            End If
                
        Case "EE"
            If Lon2 > Lon1 Then
                Dlo = Lon2 - Lon1
            Else
                Dlo = Lon1 - Lon2
            End If
                
    End Select
    
    
    Select Case Cse ' Used a constant value of 0.017453293 for converting degrees to Radians
    
    
        Case 90
                Dist = Dlo * 60 * Cos(Lat1 * 0.017453293)
        
        Case 270
                Dist = Dlo * 60 * Cos(Lat1 * 0.017453293)
        
        Case 0
                Dist = Abs((Lat1 - Lat2) * 60)
            
        Case 180
                Dist = Abs((Lat1 - Lat2) * 60)
        
        Case Else
        
            RadCse = Cse * 0.017453293  ' Course in Radians
        
            l = Abs((Lat1 - Lat2) * 0.017453293)    ' Get Difference of Latitude in Radians
        
                Dist = l / Cos(RadCse)              ' Divide Differnce of latitude by Cos of course in Radians
                Dist = RadiansToDegrees(Dist)       ' Convert back to Deerees for angular distance on earths surface
                Dist = Abs(Dist) * 60               ' Multiply by 60 to get Nautical Miles
        
    End Select
    
    
    ' display result
    
    
    MercatorDist = Dist
    
    
    MercatorDist_Exit:
        Exit Function
    
    
    MercatorDist_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume MercatorDist_Exit
    
    
    End Function
    '------------------------------------------------------------
    ' NAME: Function FormatLatitude()
    ' PORPOSE: Format a latitude string as 00-00.000N (include leading and trailing zeroa)
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: August 2023
    '-------------------------------------------------------------
    Public Function FormatLatitude(strLatValue As String)
    On Error GoTo FormatLatitude_Err
    
    
    Dim strLatDirection As String
    Dim strLatDegrees As String
    Dim strLatMinutes As String
    Dim strSeparator As String
    Dim booNonNumeric As Boolean
    
    
        ' If we are passed an empty string then exit
        If strLatValue = "" Then
            Exit Function
        End If
    
    
        ' Get rid of leading or trailing blanks
        strLatValue = Trim(strLatValue)
        ' assign value to direction variable
        strLatDirection = Right(strLatValue, 1)
    
    
    
    
    '''''' Get values for degrees and minutes''''''
        
        ' searches for "-" or " " (space or dash)
        If InStr(strLatValue, "-") > 0 Then
            strSeparator = "-"
        ElseIf InStr(strLatValue, " ") > 0 Then
            strSeparator = " "
        Else
            'Warn user and cancel Update
            MsgBox "No dash separator for Degrees/Minutes" & vbCrLf & "Please try again.", vbOKOnly + vbInformation, "Missing separator"
            Exit Function
        End If
         
        ' Assign Latitude degrees and minutes to variables and format
        strLatDegrees = Left(strLatValue, InStr(strLatValue, strSeparator) - 1)
        strLatDegrees = Format(strLatDegrees, "00")
           
        strLatMinutes = Left(Right(strLatValue, Len(strLatValue) - InStr(strLatValue, strSeparator)), _
            Len(Right(strLatValue, Len(strLatValue) - InStr(strLatValue, strSeparator))))
        
        ' strip direction and format minutes
        strLatMinutes = Left(strLatMinutes, Len(strLatMinutes) - 1)
        strLatMinutes = Format(strLatMinutes, "00.000")
    
    
        FormatLatitude = strLatDegrees & "-" & strLatMinutes & strLatDirection
    
    
    FormatLatitude_Exit:
        Exit Function
    
    
    FormatLatitude_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume FormatLatitude_Exit
    End Function
    '------------------------------------------------------------
    ' NAME: Function FormatLongitude()
    ' PORPOSE: Format a longitude string as 000-00.000N (include leading and trailing zeroa)
    ' CREATED BY: Andrew Dulavitz   (adulavitz@hotmail.com)
    ' DATE: August 2023
    '-------------------------------------------------------------
    Public Function FormatLongitude(strLonValue As String)
    On Error GoTo FormatLongitude_Err
    
    
    Dim strLonDirection As String
    Dim strLonDegrees As String
    Dim strLonMinutes As String
    Dim strSeparator As String
    
    
    ' If we are passed an empty string then exit
    If strLonValue = "" Then
        Exit Function
    End If
    
    
       ' Get rid of leading or trailing blanks
        strLonValue = Trim(strLonValue)
        ' assign value to direction variable
        strLonDirection = Right(strLonValue, 1)
            
    
    
    '''''' Get values for degrees and minutes''''''
        
        ' searches for "-" or " " (space or dash)
        If InStr(strLonValue, "-") > 0 Then
            strSeparator = "-"
        ElseIf InStr(strLonValue, " ") > 0 Then
            strSeparator = " "
        Else
            'Warn user and cancel Update
            MsgBox "No dash separator for Degrees/Minutes" & vbCrLf & "Please try again.", vbOKOnly + vbExclamation, "Missing Separator"
            Exit Function
        End If
    
    
        ' Assign Longitude degrees and minutes to variables and format
        strLonDegrees = Left(strLonValue, InStr(strLonValue, strSeparator) - 1)
        strLonDegrees = Format(strLonDegrees, "000")
        
        strLonMinutes = Left(Right(strLonValue, Len(strLonValue) - InStr(strLonValue, strSeparator)), _
            Len(Right(strLonValue, Len(strLonValue) - InStr(strLonValue, strSeparator))))
        ' strip direction
            strLonMinutes = Left(strLonMinutes, Len(strLonMinutes) - 1)
        strLonMinutes = Format(strLonMinutes, "00.000")
    
    
        FormatLongitude = strLonDegrees & "-" & strLonMinutes & strLonDirection
    
    
    FormatLongitude_Exit:
        Exit Function
    
    
    FormatLongitude_Err:
        MsgBox Err.Number & " " & Err.Description
        Resume FormatLongitude_Exit
    End Function

  2. #2
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    4,861
    Nicely commented.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  3. #3
    davegri's Avatar
    davegri is online now Excess Access
    Windows 11 Access 2019
    Join Date
    May 2012
    Location
    Denver
    Posts
    3,389
    This obviously took a lot of time, patience and knowledge to complete. I think it's admirable when people share their work after such efforts.

  4. #4
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Office 365
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    Many thanks for sharing this information which I have downloaded for future use.
    Out of interest, do your think your MercatorCse & MercatorDist procedures could be of use to the OP in this thread at: UtterAccess.com
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  5. #5
    Salty Mariner is offline Intermediate
    Windows 11 Access 2021
    Join Date
    Dec 2023
    Location
    Corpus Christi, TX
    Posts
    57
    Quote Originally Posted by isladogs View Post
    Many thanks for sharing this information which I have downloaded for future use.
    Out of interest, do your think your MercatorCse & MercatorDist procedures could be of use to the OP in this thread at: UtterAccess.com
    Good Day Colin,

    It's hard to say what he has in mind but since we are talking straight line distances and terrestrial navigation has so many twists and turns I think that google maps as you suggested are quite likely a better alternative.

    All that being said it is also quite possible to export .Kml files from google maps and extract the data from them. I worked 20 years installing and repairing submarine cables and have used Excel with Google maps to take survey data and display on Google maps. I never did it the other way around but in doing this I discovered it's possible and there are a number of software tools that can assist you in exporting/importing google maps data. It should be entirely possible to devise a way to export a 'kml file from Google maps, use one of these utilities to read/extract the geo coordinates and then import into an access table.

    As a side note around 20 years ago when I created my voyage planning application I created a utility for importing/exporting routes to/from Winfrog which was a Survey program that we used on the cable ships but it was rather simple because the survey program wrote almost everything to CSV text files. It was all a great learning experience for me as I was applying my job knowledge to doing things in software. Although it was a great learning experience I realized I was never going to compete with many of the excellent marine navigation products that have teams of professional developers working on them.

  6. #6
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Office 365
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    Hi again
    I checked my own code and found this function which I've just posted to the UtterAccess thread:

    Code:
    Function GetDistanceMetres(lat1Degrees As Single, lon1Degrees As Single, lat2Degrees As Single, lon2Degrees As Single)    Dim EarthSphereRadiusMetres As Double   ' Dim kilometerConversionToMilesFactor As Double    Dim lat1Radians As Single    Dim lon1Radians As Single    Dim lat2Radians As Single    Dim lon2Radians As Single    Dim AsinBase As Single    Dim DerivedAsin As Single    Dim Pi As Double    Pi = 3.14159265359    'Mean radius of the earth (replace with 3443.89849 to get nautical miles)    EarthSphereRadiusMetres = 6371000    'Convert kilometers into miles   ' kilometerConversionToMilesFactor = 0.621371    'Convert each decimal degree to radians    lat1Radians = (lat1Degrees / 180) * Pi    lon1Radians = (lon1Degrees / 180) * Pi    lat2Radians = (lat2Degrees / 180) * Pi    lon2Radians = (lon2Degrees / 180) * Pi    AsinBase = Sin(Sqr(Sin((lat1Radians - lat2Radians) / 2) ^ 2 + Cos(lat1Radians) * Cos(lat2Radians) * Sin((lon1Radians - lon2Radians) / 2) ^ 2))    DerivedAsin = (AsinBase / Sqr(-AsinBase * AsinBase + 1))    'Get distance from [lat1,lon1] to [lat2,lon2]   ' GetDistanceMetres = Round(2 * DerivedAsin * EarthSphereRadiusMetres, 2)    GetDistanceMetres = Round(2 * DerivedAsin * EarthSphereRadiusMetres, 0)    'Miles: = Round(2 * DerivedAsin * (earthSphereRadiusKilometers * kilometerConversionToMilesFactor), 2)    'Debug.Print GetDistanceMetres    End Function
    I never got around to using it at the time but I've just tested using a number of UK postcodes for which I have all co-ordinate data and it seems fine

    Code:
    Function TestDistanceKilometres(Postcode1 As String, Postcode2 As String) As Single
    
        Dim lat1 As Single
        Dim lon1 As Single
        Dim lat2 As Single
        Dim lon2 As Single
        
        lat1 = DLookup("Latitude", "Postcodes", "Postcode = '" & Postcode1 & "'")
        lon1 = DLookup("Longitude", "Postcodes", "Postcode = '" & Postcode1 & "'")
        lat2 = DLookup("Latitude", "Postcodes", "Postcode = '" & Postcode2 & "'")
        lon2 = DLookup("Longitude", "Postcodes", "Postcode = '" & Postcode2 & "'")
        
        Debug.Print "Postcodes: " & Postcode1 & ", " & Postcode2 & vbTab & " Distance = " & GetDistanceMetres(lat1, lon1, lat2, lon2) / 1000 & " km"
        
     End Function
    Example results:

    Code:
    ?TestDistanceKilometres ("BS25 5NB", "TA23 0RP")Postcodes: BS25 5NB, TA23 0RP  Distance: 46.93 km
    
    
    ?TestDistanceKilometres ("SE1 7PB", "HA3 0SN")
    Postcodes: SE1 7PB, HA3 0SN   Distance: 15.072 km
    
    
    ?TestDistanceKilometres ("SE1 7PB", "BS7 8HP")
    Postcodes: SE1 7PB, BS7 8HP   Distance: 171.52 km
    
    
    ?TestDistanceKilometres ("SE1 7PB", "TA23 0RP")
    Postcodes: SE1 7PB, TA23 0RP   Distance: 230.867 km
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  7. #7
    Salty Mariner is offline Intermediate
    Windows 11 Access 2021
    Join Date
    Dec 2023
    Location
    Corpus Christi, TX
    Posts
    57
    Colin,

    That looks good, the formulas use basic spherical trigonometry which over shorter distance produce perfectly acceptable results. There are a plethora of Calculation methods in use which ones are preferable in each circumstance is dependent on a number of different factors but perhaps the most important one is the Datum in use. with the advent of GPS most uses have settled on WGS84. This is mainly because the earth is not a perfect sphere and has some flattening at the poles. Maps and Charts have been produced over the years that use different Datums. when using different chart datums corrections must be applied or errors will result. There are some navigational charts that when using GPS data can produce significant errors if not corrected.

    Likewise when measuring angles on a sphere we must keep in mind the we exist on a flat plane (our frame of reference) and that over large areas any course angle other than 0, 90, 180, or 270 degrees is going to be continuously changing as we move across the sphere. This is a Great Circle. In marine navigation we interpret this as a series of straight lines (Rhumb Lines) that change as we move across the ocean. while one can keep the same course angle for long distances (Rumb Line) the shortest distance will be a great circle. These are never usually a problem in the real world as long as we are aware of the limitations and built in errors of whatever calculation method we are using.

    You are likely aware of what I just re-iterated but I thought I would throw this in there for the benefit of anyone who is curious and wants to delve into these types of calculations. Almost every calculation method involves some some tradeoffs in accuracy you just need to choose the best one for your application.

  8. #8
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Office 365
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    I was aware of most of the details but well worth explaining for the benefit of everyone. Never heard of Rumb lines before
    As you say, all calculations involve some degree of approximation (earth isn't spherical, altitude variations not included) but are likely to be good enough for the average user.
    In any case, nobody will ever travel the linear distance between 2 locations.

    Anyway, I've just published an article with my code and an example app to Calculate Distance Between Locations (isladogs.co.uk)

    You might also be interested in my earlier article from 2022 Missing Trigonometric Functions (isladogs.co.uk) which includes code for 6 additional trig functions (ASin / ACos / ACot / ASec / ACsc / Atn2) not provided with Access. I use two of those in the code needed to draw circles on maps (also provided).
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  9. #9
    Salty Mariner is offline Intermediate
    Windows 11 Access 2021
    Join Date
    Dec 2023
    Location
    Corpus Christi, TX
    Posts
    57
    Quote Originally Posted by isladogs View Post
    I was aware of most of the details but well worth explaining for the benefit of everyone. Never heard of Rumb lines before
    As you say, all calculations involve some degree of approximation (earth isn't spherical, altitude variations not included) but are likely to be good enough for the average user.
    In any case, nobody will ever travel the linear distance between 2 locations.

    Anyway, I've just published an article with my code and an example app to Calculate Distance Between Locations (isladogs.co.uk)

    You might also be interested in my earlier article from 2022 Missing Trigonometric Functions (isladogs.co.uk) which includes code for 6 additional trig functions (ASin / ACos / ACot / ASec / ACsc / Atn2) not provided with Access. I use two of those in the code needed to draw circles on maps (also provided).
    Colin,

    You do excellent work. I've followed your postings online for a while and you do a great service for others making difficult concepts understandable. I have bookmarked both of these for future reference. Thanks for all you do.

    On a personal level I think the better achievement that I achieved with the code posted here was the Lat/Lon validation routines and the code to convert Lat/Lon strings to decimal degrees and back to a string. Most mariners I know do not want to be bothered trying to use decimal degrees and figure out whether to use a positive or a negative number. They work every day in degrees, minutes and decimal minutes of latitude and longitude with a N, S, E, or W indicator. So I felt it was important that whatever I did behind the scenes that the end user is able to work in a way they are accustomed to.

  10. #10
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Office 365
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    Thanks for your feedback.
    I noticed all your validation code and agree with you on its importance.
    Whilst I personally prefer decimal values for lat/long, I agree with you about providing data in the format that users are most comfortable with. But why not degrees, minutes and seconds in your case?
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  11. #11
    Salty Mariner is offline Intermediate
    Windows 11 Access 2021
    Join Date
    Dec 2023
    Location
    Corpus Christi, TX
    Posts
    57
    Quote Originally Posted by isladogs View Post
    Thanks for your feedback.
    I noticed all your validation code and agree with you on its importance.
    Whilst I personally prefer decimal values for lat/long, I agree with you about providing data in the format that users are most comfortable with. But why not degrees, minutes and seconds in your case?
    Most GPS units and most correspondence in navigational publications such as Notice to Mariners is notated as decimal minutes. It makes sense when you think about it since 1 minute of latitude is equal to 1 Nautical Mile and we commonly refer to nautical miles in decimals it makes for relatively simple mental arithmetic. Sure, 6 seconds is 1/10th of a minute , but many Charts are delineated in decimals of nautical miles so it's easier (and reduces errors) if we consistently work in the same units.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 08-02-2023, 08:02 PM
  2. Best Way to Handle Different Latitude and Longitude Formats
    By Ecologist_Guy in forum Database Design
    Replies: 6
    Last Post: 04-06-2017, 04:33 PM
  3. Latitude and Longitude alteration
    By tmcrouse in forum Access
    Replies: 3
    Last Post: 11-19-2015, 10:40 AM
  4. latitude and longitude w Google
    By wnicole in forum Access
    Replies: 2
    Last Post: 03-26-2014, 10:58 AM
  5. How can I get latitude and longitude
    By w0st in forum Access
    Replies: 1
    Last Post: 01-05-2014, 05:28 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums