Help modifying a VBA Code 1

[YEngineer]

The code below calculates the minimal distance in space of between two lines.
Points of line 1 have their coordinates x,y,z in columns c,d,b and those of line 2 in columns r,s,q. The minimal value is displayed in a message.
I want to change the macro so that each minimal distance for each point on line 1 is calculated and displayed in adjacent cells in column e. I tried to modify the macro by adding a loop calculation but failed miserably. Can somebody help?
Thanks

Sub find_closest_distance()

With Worksheets("sheet1")
x1 = "c": y1 = "d": z1 = "b"
firstrow1 = 5
lastrow1 = .Cells(.Rows.Count, x1).End(xlUp).Row
x2 = "r": y2 = "s": z2 = "q"
firstrow2 = 5
lastrow2 = .Cells(.Rows.Count, x2).End(xlUp).Row

ning = .Cells(8, "x")
eing = .Cells(9, "x")
Eion = .Cells(7, "x")

min_distance = 1E+300
For i = firstrow1 To lastrow1
x1_acc = .Cells(i, x1): y1_acc = .Cells(i, y1): z1_acc = .Cells(i, z1):
For j = firstrow2 To lastrow2
x2_acc = ning + .Cells(j, x2): y2_acc = eing + .Cells(j, y2): z2_acc = Eion + .Cells(j, z2)

dist1 = (x1_acc - x2_acc) ^ 2 + (y1_acc - y2_acc) ^ 2 + (z1_acc - z2_acc) ^ 2
If dist1 < min_distance Then
min_distance = dist1
min_i = i: min_j = j
min_x1_acc = x1_acc: min_y1_acc = y1_acc: min_z1 = z1_acc
min_x2_acc = x2_acc: min_y2_acc = y2_acc: min_z2 = z2_acc
End If
Next j
Next i

MsgBox "Then miniumum distance is " & Sqr(min_distance) & " from point (Z = " & min_z1 & ", X = " & min_x1_acc & ", Y = " & min_y1_acc & ") to point (Z = " & min_z2 - Eion & ", X = " & min_x2_acc - ning & ", Y = " & min_y2_acc - eing & ")"

End With
End Sub

 

[IDS]

Ammended code to write minimum distance for each row to column E, point on Line 2 to Column F and overall minimum and points to cells E#, G3, and I3:

 min_distance = 1E+300
 For i = firstrow1 To lastrow1
 min_distance_i = 1E+300
 x1_acc = .Cells(i, x1): y1_acc = .Cells(i, y1): z1_acc = .Cells(i, z1):
 For j = firstrow2 To lastrow2
 x2_acc = ning + .Cells(j, x2): y2_acc = eing + .Cells(j, y2): z2_acc = Eion + .Cells(j, z2)

 dist1 = (x1_acc - x2_acc) ^ 2 + (y1_acc - y2_acc) ^ 2 + (z1_acc - z2_acc) ^ 2
 If dist1 < min_distance_i Then
 min_distance_i = dist1
 min_j_i = j
 
 End If
 Next j
 
 .Cells(i, "e") = Sqr(min_distance_i)
 .Cells(i, "f") = min_j_i
 
 If min_distance_i < min_distance Then
 min_distance = min_distance_i
 min_i = i: min_j = min_j_i
 
 End If
 Next i
 
 .Cells(3, "e") = Sqr(min_distance)
 .Cells(3, "g") = min_i
 .Cells(3, "i") = min_j
 
 End With
 End Sub

Doug Jenkins
Interactive Design Services

http://newtonexcelbach.wordpress.com/

 

[YEngineer]

Thank you very much IDS, it worked. For future references for the guys who do not know VBA the array formula is:
MIN((($B$5:$B$500-Q5-$X$7)^2+($C$5:$C$500-R5-$X$8)^2+($D$5:$D$500-S5-$X$9)^2)^0.5)
thanks again IDS

 

[YEngineer]

acknowledged