Sort in proper order

Option Explicit

Sub test()
    Dim a, i As Long, ii As Long, w, EAS, NORTH, x As Object, n As Long, Head
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    ReDim Head(1 To UBound(a, 2) + 1)
    For i = 1 To UBound(a, 2)
        If i = 3 Then Head(i) = "OFFET"
        Head(i + IIf(i > 2, 1, 0)) = a(1, i)
    Next
    With CreateObject("System.Collections.SortedList")
        For i = 2 To UBound(a, 1)
            If Not .Contains(a(i, 1)) Then
                Set .Item(a(i, 1)) = _
                CreateObject("System.Collections.ArrayList")
            End If
            ReDim w(1 To UBound(a, 2) + 1)
            w(1) = "0+" & Format$(a(i, 1), "")
            For ii = 2 To UBound(a, 2)
                w(ii + IIf(ii > 2, 1, 0)) = a(i, ii)
            Next
            .Item(a(i, 1)).Add w
        Next
        For i = 0 To .Count - 1
            For ii = 0 To .GetByIndex(i).Count - 1
                EAS = Empty: NORTH = Empty
                If .GetByIndex(i)(ii)(2) = "CL" Then
                    EAS = .GetByIndex(i)(ii)(4)
                    NORTH = .GetByIndex(i)(ii)(5)
                    Exit For
                End If
            Next
            If Not IsEmpty(EAS) Then
                For ii = 0 To .GetByIndex(i).Count - 1
                    w = .GetByIndex(i)(ii)
                    w(3) = Sqr((EAS - w(4)) ^ 2 + (NORTH - w(5)) ^ 2) * IIf(w(2) = "LHS", -1, 1)
                    .GetByIndex(i)(ii) = w
                Next
            End If
        Next
        Set x = .Clone
    End With
    With Sheets.Add.Cells(1).Resize(, UBound(w))
        .Value = Head: n = 2
        For i = 0 To x.Count - 1
            With .Rows(n).Resize(x.GetByIndex(i).Count)
                .Value = Application.Index(x.GetByIndex(i).ToArray, 0, 0)
                .Sort .Cells(1, 3), 1
            End With
            n = n + x.GetByIndex(i).Count + 1
        Next
        With .Resize(.Parent.Cells.SpecialCells(11).Row)
            .Font.Bold = True: .Borders.Weight = 2
            .HorizontalAlignment = xlCenter: .Columns.AutoFit
        End With
    End With
End Sub