×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Help modifying a VBA Code

Help modifying a VBA Code

Help modifying a VBA Code

(OP)
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

RE: Help modifying a VBA Code

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:

CODE -->

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/

RE: Help modifying a VBA Code

(OP)
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

RE: Help modifying a VBA Code

(OP)
acknowledged

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login



News


Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close