Excel VBA locate nearest point

[nitn28]

HI everyone

I hav sent a post earlier [match numerical data using excel vba] , wel
after posting that i thot abt it more n sipplified this
way ............

I have x,y coordinates of say 1000 points [no. of points vary ] (data
set 1) n also dataset2 of around 2500 points ....

now i want to locate the nearest coordinate using formula

d = ((x2-x1)^2+(y2-y1)^2) should be minimum , but i m unable to
program it correctly

say for example here are two data sets
dataset1 a1:b9 dataset2 e1:f9
data set 1 dataset 2

1 9 9 1
2 8 8 2
3 7 7 3
4 6 6 4
5 5 5 5
6 4 4 6
7 3 3 7
8 2 2 8
9 1 1 9

dataset above is not actual , its just an example
now wat i want to do it to first of chk cell(1,1) and cell(1,2)
values [dataset1] and find distance using coordinates of dataset and
where evr it find minimum distane "d" [ in above xaple its cell(9 ,
5 ) n cell(9,6 )]
copy the cooresponding coordinates n front of dataset1
values that is in cell(1,3) and cell(1,4)

i hope i hav made my problem clear, for further xplaination plz let me
knw

Many thanks for any or all suggestions

 

[sali]

HI everyone

d = ((x2-x1)^2+(y2-y1)^2) should be minimum , but i m unable to
program it correctly

very simple example, what about:
--------------------8<---------

Const rownum1 = 10 'rows of column1
Const rownum2 = 20 'rows of column2
Const min0 = 1000 'starting minimum, but enough big to be bigger than final

Sub distance1()
Dim i As Integer, j As Integer, d As Double, dmin As Double, rmin As
Integer
With ActiveSheet
For i = 1 To rownum1
dmin = min0
rmin = -1
For j = 1 To rownum2
d = d1(.Cells(i, 1), .Cells(j, 5), .Cells(i, 2), .Cells(j,
6))
If d < dmin Then
rmin = j
dmin = d
End If
Next
.Cells(i, 7).Value = rmin
.Cells(i, 8).Value = dmin
.Cells(i, 3).Value = .Cells(rmin, 5)
.Cells(i, 4).Value = .Cells(rmin, 6)
Next
End With
End Sub

Function d1(x1 As Double, x2 As Double, y1 As Double, y2 As Double) As
Double
d1 = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function

 

[Guest]

This will get your answers. If two distances are the same, it will use the
one in the lowest row.


Sub sortdistance()

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row


For i = 1 To LastRowA
X = Cells(i, "A")
Y = Cells(i, "B")

For j = 1 To LastRowE
distance = Sqr((X - Cells(j, "E")) ^ 2 + (Y - Cells(j, "F")) ^ 2)
If j = 1 Then
shortX = Cells(j, "E")
shortY = Cells(j, "F")
shortdistance = distance
Else
If distance < shortdistance Then
shortX = Cells(j, "E")
shortY = Cells(j, "F")
shortdistance = distance
End If
End If
Next j

Cells(i, "C") = shortX
Cells(i, "D") = shortY
Next i

End Sub

 

[thankfulguy]

hi "sali" & " =?Utf-8?B?Sm9lbA==?="

many thanks for ur time n replys it worked fine............

i hav one more small querry i wud like to copy the next column value corresponding to minimum distance values

say if i hav found shortest distance values for a1:b1 in f4:g4 ( changes "e" to " F" n "f" to "g " ) then i wud like to copy h4 to e1
hop i hav made my problm clear

many thanx