Condition based copy/paste of range

N

nitn28

hello everyone

i m learning alot from this group
i need direction to solve this problm, which i m trying hard but not
able to write xact vba code/macro bcoz m novice

i hav data in two columns

a b

1(x1) 2(y1)
3(x2) 4(y2)
5 6
7 8
9 10
16 17
18 19
20 21
25 27

i want to calucate distance between two sets of data which are in
column "a" and "b"

d = sqrt((x2-x1)^2+(y2-y1)^2))

and if d is >=4 or <=-4 then

data set should be copied to next columns wherever this condition not
satisfied

for eg

a b c d e
f

a1 b1 a1 b1 a6 b6
a2 b2 a2 b2 a7 b7
a3 b3 a3 b3 a8 b8
a4 b4 a4 b4
a5 b5 a5 b5
a6 b6
a7 b7
a8 b8
a9 b9


in above example i tried to show dat from a1:b5 ( "d" is less than 4
so copied in column "c" and "d" ,

but value of "d " is .> 4 for "a6,b6 & a5,b5"
so copied in next colmn til difference is less than 4
and like wise a9,b9 in next columns

hop i hav made my problm bit clear

hop i wil get some suggestions to write a code
witing for ur replys
many thanx in advance
4 ur time n efort
 
B

Barb Reinhardt

I'm going to assume that your data is in columns A and B and you have a
header in the first row.

I don't think this is exactly what you want, but you're going to have to
tell us what needs to be changed. You may be able to figure out your code
from here.

Sub test()

Dim myRange As Range
Dim r As Range
Dim d As Variant

Set myRange = Cells(3, 1)
lrow = Cells(Rows.Count, myRange.Column).End(xlUp).Row
Set myRange = myRange.Resize(lrow, 1)

For Each r In myRange
d = Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + (r.Offset(0, 1).Value -
r.Offset(-1, 1).Value) ^ 2)
Debug.Print r.Address, d
If Abs(d) < 4 Then
r.Offset(0, 2).Value = r.Value
r.Offset(0, 3).Value = r.Offset(0, 1).Value
End If
Next r

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top