An Excel VBA macro used to jump to a row of a spreadsheet containing a latitude and a longitude column, where that row is closest to a target lat/long.

LookupClosestLatLong.bas

Option Explicit ' require strict variable 'dim' statements to avoid typos

Public Sub LookupClosestLatLong()
    ' Runs a procedure that prompts the user a few times, and takes them to the row of a pipe tally closest to some input coords.
    ' @since 2021-04-15
    
    ' Note to self: Range.Cells(row number, col number) is 0-index. Cells(2,1) = B3. Good luck.
    
    Dim LatColNum As Long
    Dim LonColNum As Long
    Dim iCol As Long ' col number
    Dim iRow As Long ' row number
    Dim TargetLLStr As Variant
    Dim TargetLat As Double
    Dim TargetLon As Double
    
    Dim CurMinDistance_m As Double
    Dim CurMinRowNum As Long
    Dim ThisDist_m As Double
    
    
    LatColNum = 0
    LonColNum = 0
    CurMinDistance_m = 9999999
    
    ' Step 1: Figure out which columns are the lat and long ones
    For iCol = 1 To ActiveSheet.UsedRange.Columns.Count
        For iRow = 1 To 50
            ' Loop through first 50 rows trying to find the 'lat' and 'long' text to find what columns the lat/long are in
            
            If InStr(LCase(Cells(iRow, iCol).Value2), "latitude") Then
                LatColNum = iCol
            ElseIf InStr(LCase(Cells(iRow, iCol).Value2), "longitude") Then
                LonColNum = iCol
            End If
            
        Next iRow
    Next iCol
    
    If LatColNum = 0 Or LonColNum = 0 Then
        MsgBox "Sorry, I couldn't find the lat/long columns. Please rename one column to 'Latitude' and one column to 'Longitude'. Thanks!"
        Exit Sub ' early exit, error
    End If
    
    ' Step 2: Prompt for target lat/long
    TargetLLStr = InputBox("Please enter a lat/long pair in a form like this: '45.3543453, -101.23435445'. Pro tip: If you've copied lat/long separately, use Windows+V to paste your clipboard history.")
    TargetLLStr = Replace(TargetLLStr, " ", "") ' remove spaces
    
    If InStr(TargetLLStr, ",") = 0 Then
        MsgBox "Invalid input. Cancelling. Please try again."
        Exit Sub
    End If
    
    ' Step 3: Split lat/long apart into separate doubles
    TargetLat = CDbl(Split(TargetLLStr, ",")(0))
    TargetLon = CDbl(Split(TargetLLStr, ",")(1))
    
    ' Step 4: Iterate through all rows in pipe tally, checking each row to see how close it is to the target lat/long
    For iRow = 1 To ActiveSheet.UsedRange.Rows.Count
        If IsNumeric(Cells(iRow, LatColNum)) And IsNumeric(Cells(iRow, LonColNum)) Then ' if cell contains a numeric value
            ThisDist_m = HaversineDist(Lat1:=TargetLat, Lon1:=TargetLon, Lat2:=Cells(iRow, LatColNum).Value2, Lon2:=Cells(iRow, LonColNum).Value2)
            
            If ThisDist_m < CurMinDistance_m Then
                CurMinDistance_m = ThisDist_m
                CurMinRowNum = iRow
            End If
            
        End If
    Next iRow
    
    ' Step 5: Tell the user what row, jump to that row
    MsgBox "The closest row is row " & CurMinRowNum & ", at " & Round(CurMinDistance_m, 2) & "m away from target coords (" & TargetLLStr & "). Click Ok to jump to that row!"
    Rows(CurMinRowNum).Activate
    
    If CurMinDistance_m > 100 Then
        MsgBox "You're probably in wrong pipe tally. Yours coords were more than 100m away from any coords in this pipe tally. Good luck!"
    End If

End Sub



Public Function HaversineDist(Lat1 As Double, Lon1 As Double, Lat2 As Double, Lon2 As Double)
    ' Calculates approx distance between two sets of coordinates.
    ' @return straight-line approximation in meters
    ' Source: https://stackoverflow.com/questions/35175057/vba-haversine-formula (note that the question contains a bug, answered in the question)
        
    Dim R As Integer, dlon As Variant, dlat As Variant, Rad1 As Variant
    Dim a As Variant, c As Variant, d As Variant, Rad2 As Variant
    
    R = 6371
    dlon = Excel.WorksheetFunction.Radians(Lon2 - Lon1)
    dlat = Excel.WorksheetFunction.Radians(Lat2 - Lat1)
    Rad1 = Excel.WorksheetFunction.Radians(Lat1)
    Rad2 = Excel.WorksheetFunction.Radians(Lat2)
    a = Sin(dlat / 2) * Sin(dlat / 2) + Cos(Rad1) * Cos(Rad2) * Sin(dlon / 2) * Sin(dlon / 2)
    
    ' c = 2 * Excel.WorksheetFunction.Atan2(Sqr(a), Sqr(1 - a)) ' original bad line in question
    c = 2 * Excel.WorksheetFunction.Atan2(Sqr(1 - a), Sqr(a)) ' fixed in solution

    d = R * c
    HaversineDist = d * 1000
    
End Function