Sub sortGeoPoints(rngCoords As Range, rngSortOrder As Range)
              
     Dim cnn         As Object 'As ADODB.Connection
     Dim rst1        As Object 'As ADODB.Recordset
     Dim rst2        As Object 'As ADODB.Recordset
     Dim fieldList
     Dim x0          As Double
     Dim y0          As Double
     Dim i           As Integer
     Dim sqlSource   As String
      
     Set cnn = CreateObject("ADODB.Connection")
     Set rst1 = CreateObject("ADODB.Recordset")
     Set rst2 = CreateObject("ADODB.Recordset")
     
     cnn.Open _
     "Provider=Microsoft.ACE.OLEDB.12.0;" & _
     "Data Source=" & ThisWorkbook.FullName & ";" & _
     "Extended Properties='Excel 12.0;HDR=No'"
                  
     sqlSource = "[" & rngCoords.Worksheet.Name & _
                 "$" & rngCoords.Address(False, False) & "]"
                  
     rst1.Open "SELECT * FROM " & sqlSource, cnn
              
     With rst2.Fields
         .Append "F4", 3 'adInteger  'рассчитанный порядок сортировки - на 1-й позиции для удобства вывода на лист
         .Append "F1", 5 'adDouble   'координата X - широта
         .Append "F2", 5 'adDouble   'координата Y - долгота
         .Append "F3", 5 'adDouble   'расстояние между геоточками
         .Append "F5", 3 'adInteger  'исходный порядок сортировки
     End With
     rst2.Open
                         
     fieldList = Array("F1", "F2", "F3", "F4", "F5")
              
     'формирование массива 2
     i = 0
     With rst1
         .MoveFirst
         Do While Not .EOF
             i = i + 1 'запоминаем исходный порядок записей
             rst2.AddNew fieldList, Array(!F1, !F2, 0, 0, i)
             .MoveNext
         Loop
     End With
              
     'обработка массива 2
     i = 0
     With rst2
         Do
             i = i + 1
             .MoveFirst
             x0 = !F1
             y0 = !F2
             .Update "F4", i
              
             .Filter = "F4 = 0"
             Do While Not .EOF
                 .Update "F3", dln(x0, y0, !F1, !F2)
                 .MoveNext
             Loop
             rst2.Sort = "F3 ASC" 'сортируем по расстоянию
         Loop Until .RecordCount = 0
          
         .Filter = ""
         .Sort = "F5 ASC" 'восстанавливаем исходный порядок
         .MoveFirst
     End With
         
     rngSortOrder.CopyFromRecordset rst2, , 1 'вывод одной самой левой колонки
                    
End Sub

Function dln#(x1#, y1#, x2#, y2#) '(c) заимствовано у MCH
     Const pi# = 3.14159265358979
     dln = 6371 * WorksheetFunction.Acos(Sin(x1 / 180 * pi) * Sin(x2 / 180 * pi) + Cos(x1 / 180 * pi) * Cos(x2 / 180 * pi) * Cos((y1 - y2) / 180 * pi))
End Function