PDA

View Full Version : Sort by Distance to Each Successive Point



MrRhodes2004
05-20-2013, 10:36 AM
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 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.
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.

SamT
05-20-2013, 08:43 PM
I hope you have as much fun figuring out what I did as I did figuring out what I did wrong. :beerchug:

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

snb
05-21-2013, 03:18 AM
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

MrRhodes2004
05-21-2013, 06:09 AM
Interesting, in both SamT and snb, I get type mismatch errors.

snb
05-21-2013, 06:47 AM
I don't in the file you posted.

SamT
05-21-2013, 08:35 AM
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.

MrRhodes2004
05-21-2013, 08:35 AM
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. :bow:

Let the fun begin! Thank you

snb
05-22-2013, 01:06 AM
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:


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