Selected Answer
Hi and welcome to the Forum
In the revised (macro-enabled) file, I've moved your formula information (in A18;A19) one cell to the right. This lets VBA calculate the last row used in column A and you to make the table 15 rows, 250 rows or whatever (up to the Excel limit).
There's a button in row 1 called "Calculate interlocation distances"- click that and it will call the macro below. Note that the message box offers a default value of 4,000m (which you can change) which will give meaningful results since, if your formula is correct, for the first 15 (original) locations there were no locations within 100m of each other as your question requests. Using 1,500 gives 1 "neighbour" for most locations.
Note that I've set the output to also show the interlocation distances (to two decimal places) in column E so you can check that the calculations have be done correctly.
REVISION: in a file you posted as an Answer, you had about 5,000 rows of data. Turns out some rows had the same latitude and longitude (e.g. rows 16 and 19) which caused the ACOS function to fail (I think it was a divide by zero error so you were asking for the arc cosine of an indeterminate number. I've added a new IF trap to avoid performing than calculation when the co-ordinates are the same. (As the revised file leaves me, Targ is set to 100 and you'll see lots of location pairs where the distance between is zero)
The code below is commented for your guidance about VBA actions. Note that the first line is important for the way the array is handled:
Option Base 1
Sub LessThanTarg()
Dim DataArray() As Variant, Rw As Long, LstRw As Long, Rw2 As Long
Dim Dist As Double, Pi As Double, Targ As String
'get threshold from user
Targ = InputBox("Maximum interlocation distance?", "What threshold do you want?", 4000)
If Targ = "" Or Not IsNumeric(Targ) Then Exit Sub
' set Pi (not a VBA Constant)
Pi = WorksheetFunction.Pi
' get last row in column A
LstRw = Range("A" & Rows.Count).End(xlUp).Row
' clear results columns
Range("D2:E" & LstRw).ClearContents
'grab data to array
DataArray = Range("A2:E" & LstRw).Value
'Loop first set of co-ordinates
For Rw = 1 To LstRw - 1
'Loop second sets of co-ordinates
For Rw2 = Rw + 1 To LstRw - 1
'set values for formula
Lat1 = DataArray(Rw, 2)
Lon1 = DataArray(Rw, 3)
Lat2 = DataArray(Rw2, 2)
Lon2 = DataArray(Rw2, 3)
If (Lat1 = Lat2) And (Lon1 = Lon2) Then
'same place so avoid 0/0 error in calculation
Dist = 0
Else
' calculate distance from data above using VBA functions and worksheet function ACOS (not covered by VBA)
Dist = WorksheetFunction.Acos(Sin(Lat1 * Pi / 180) * Sin(Lat2 * Pi / 180) + Cos(Lat1 * Pi / 180) * Cos(Lat2 * Pi / 180) * Cos(Lon2 * Pi / 180 - Lon1 * Pi / 180)) * 6371000
End If
'compare distance with threshold
If Dist < CDbl(Targ) Then
'If less, write/add to the array
DataArray(Rw, 4) = DataArray(Rw, 4) + 1
DataArray(Rw, 5) = DataArray(Rw, 5) & DataArray(Rw2, 1) & " (" & Format(Dist, "#,##0.00") & "m), "
DataArray(Rw2, 4) = DataArray(Rw2, 4) + 1
DataArray(Rw2, 5) = DataArray(Rw2, 5) & DataArray(Rw, 1) & " (" & Format(Dist, "#,##0.00") & "m), "
End If
Next Rw2
Next Rw
'write data back to worksheet
Range("A2:E" & LstRw).Value = DataArray()
' revised column D heading
Range("D1").Value = "Count of locations within " & Targ & " meters of other locations"
MsgBox "Data written and cell D1 revised to " & Targ & "m"
End Sub
Incidentally, your sheet had thousands and thousands of blank rows and columns so I copied your data to another sheet (and deleted the first sheet) so that the used range was reset to something like normal ($A$1:$J$20 for me).
Hope this helps.
