Consulting

Results 1 to 8 of 8

Thread: Sort by Distance to Each Successive Point

  1. #1

    Sort by Distance to Each Successive Point

    I have data with Latitude and Longitude:
    Location, Lat, Long
    1,30.6382,-97.5985
    2,30.2877,-97.0584
    3,30.4178,-97.4824
    4,30.3616,-97.3635
    5,30.2608,-97.0588
    6,30.2955,-97.0056
    7,30.4251,-97.5755

    I would like to start with location 1 and sort by distance [FONT='Calibri','sans-serif']to each successive point. To calculate the distance between the points, I use square root some of the squares from the start point, location 1, to all other points =sqrt(abs(30.6382-30.3877)+abs(-97.5985-(-97.0584))). Then sort locations 2-7 based on SRSS.[/FONT]
    I then repeat the process with the new start point and the new location 2, the closest item to 1. Calc SRSS, Sort 3-7. Repeat until all locations have been sorted.

    I have attached a workbook that has the information.

    VBA Code:
    1. Select Full Data Range
    2. Select Starting Lat and Long
    3. Sort By Distance
    4. Put Sorted Data on New Sheet

    I am trying to write the code but I can do it with the brute force method – copy, calc, sort, copy calc, sort…. However, I would like suggestions on how to do this via a different method, something more elegant.
    Attached Files Attached Files

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    I hope you have as much fun figuring out what I did as I did figuring out what I did wrong.

    [vba]Sub SamT()
    Const Trip As Long = 5 'Col
    Const Dist As Long = 6 'Col
    Dim Rw As Long


    'Clear previous results
    Range(Cells(3, Trip), Cells(Cells(Rows.Count, Trip).End(xlUp).Row, Dist)) _
    .ClearContents
    For Rw = 3 To Cells(Rows.Count, 2).End(xlUp).Row - 1
    Cells(Rw, Trip) = Rw - 2

    'This line errors on second iteration
    Cells(Rw, Dist) = Sqr(Abs((Cells(Rw, 2) - Cells(Rw + 1, 2)) ^ 2) + Abs((Abs(Cells(Rw, 3)) - Abs(Cells(Rw + 1, 3))) ^ 2))
    Next Rw

    Range(Cells(3, Trip), Cells(Cells(Rows.Count, Trip).End(xlUp).Row, Dist)) _
    .Sort Key1:=Cells(Cells(Rows.Count, Trip).End(xlUp).Row, Dist)
    End Sub[/vba]
    Attached Files Attached Files
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    [VBA]Sub M_snb()
    sn = Sheets("original data").Cells(1).CurrentRegion

    With CreateObject("System.Collections.ArrayList")
    For j = 4 To UBound(sn)
    .Add Format(Sqr(Abs(sn(3, 2) - sn(j, 2)) + Abs(sn(3, 3) - sn(j, 3))), "0.000000") & "_" & Format(sn(j, 1), "00")
    Next
    .Sort
    Sheets("original data").Cells(4, 10).Resize(.Count) = Application.Transpose(.toarray())
    End With
    End Sub[/VBA]

  4. #4
    Interesting, in both SamT and snb, I get type mismatch errors.

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    I don't in the file you posted.

  6. #6
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    When running in my attachment or when pasting the code sample into your book?

    BTW, I fixed the error the "This Line..." comment refers to, just forgot to remove the comment.

    I had the help of some good Canadian while debugging that.

    BTW, again, You can substitute the Constants Lat As Long = 2 and Lng As Long = 3 for the nums 2 and 3 in the Cell references. Might make the code easier to read.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  7. #7
    Thanks snb, I copied out the posted file and it works. Something must have changed in my current file.
    Now to use your code with a larger data set.

    Let the fun begin! Thank you

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    You better remove all merged cells before using VBA (better to avoid them anyhow)

    If you delete the first row in sheet 'original data' you can sort without showing anywhere how and based on what, with:

    [VBA]
    Sub M_snb()
    sn = Sheets("original data").Cells(1).CurrentRegion

    With CreateObject("System.Collections.ArrayList")
    For j = 3 To UBound(sn)
    .Add Format(Sqr(Abs(sn(2, 2) - sn(j, 2)) + Abs(sn(2, 3) - sn(j, 3))), "0.000000") & "_" & Format(sn(j, 1), "00")
    Next
    .Sort
    sp = .toarray()
    End With

    For j = 0 To UBound(sp)
    sp(j) = Val(Split(sp(j), "_")(1)) + 1
    Next
    sp = Split("1|2|" & Join(sp, "|"), "|")

    Sheets("original data").Cells(1, 5).Resize(UBound(sn), UBound(sn, 2)) = Application.Index(sn, Application.Transpose(sp), Array(1, 2, 3))
    End Sub
    [/VBA]
    Last edited by snb; 05-22-2013 at 01:47 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •