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