pasting data in different columns

[nitn28]

hello evrybody.......

i m trying to fix this prblem for last few days

i have data in col.A , col.B,
say i hav 10 values [in cloumns above]
and wat i wanted to do with these values is to copy in different
columns "based on condition"

"My conditions is "

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)
If Abs(d) >10 Then
then copy them to col.C, col.D and so on

say if first 5 values satisfy that condition then copy them to col.C,
col.D

NOW if 6 value donot satsfi the condition then copy it to columnE n
the condition is satisfied upto 8 value so copy the value of colA ,
colB in =====ColE,ColF

again 9 value do not satisfy copy it to next column ColmnG , ColH

hope i get some help from this forum
waiting 4 ur replys
Many thanx in advance

 

[Joel]

Sub splitcol()

LastRowC = Cells(Rows.Count, "C").End(xlUp).Row + 1
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row + 1

d = Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + _
(r.Offset(0, 1).Value - r.Offset(-1, 1).Value) ^ 2)
If Abs(d) > 10 Then
Cells(LastRowC, "C") = r.Offset(-1, 1).Value
Cells(LastRowC, "D") = r.Value
Else
Cells(LastRowE, "E") = r.Offset(-1, 1).Value
Cells(LastRowE, "F") = r.Value

End If


End Sub

 

[nitn28]

Thnx Mr Joel

For ur reply, ur effort n spending valuable time for me

actually this not wat i want to do , ur code worked fine its puting
data in "c" &"d" but my requiremnts are different

i hav around 2000 values in columns "a and b" now wat i wanted to do i
m xplaining here once again
my values are lik this

"D"= Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + (r.Offset(0,
1).Value - r.Offset(-1, 1).Value) ^ 2)

that say 1-90 values hav "D" < 10 so put them in col "c & d" now 90
and 91 values have "D" > 10
so i want value to b pasted in col "e" & "f' again when i compare 91
with 92 it returns "D" < 10 and it follws upto say 140
i want all these 91-140 value in col" e" & "f" and a loop which fill
values in other columns g,h,i,j.....til alll 2000 values get cheked
and pasted.

many thanx

 

[Joel]

You are still not very clear in specifying your requirements. I think you
are looking to sort the values based on d and put the results inot differntt
columns based on the sort. what is not clear is how big each sort range is
goiing to be. The first size is 90 items 1-90, then the 2nd set is only 50,
91-140. You can't have both.

 

[nitn28]

One idea/logic to approach this problem but unable to programme it as
i am a novice

1] why dont we insert an empty cell above the value which gives
whenevr "D" > 10

"D" = Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + (r.Offset(0,
1).Value - r.Offset(-1, 1).Value) ^ 2)

say if "D" = 11 for cell a90 , b90 & a 91 , b91 value......then insert
cell above a91 and b 91

similarly wherevr we get "d" > 10

2} Now the second part, copy all the value before first empty cel
occurs say in row a91 empty cell ocurs so code shud copy all values
above empty cell n paste the a1:b91 values in col.c n col.d [c1:d91]

like wise if again empty cell occur at a140 then copy values from
a92:b139 n paste them to col .e & col.f [E1:F47]

i hop now the prblem its quite clear plz suggest some vba code/ideas
if u hav n some sites from wher i can learn such kinda code

many thanx

 

[Joel]

the header row approach is an excellent suggestion. i did something like
that for somebody last weekend.

 

[nitn28]

hi mr .joel thanx for ur reply

but wil u plz tel me the code u did last week

i m novice n using my logic and trying to put it programming
but i m begineer so unable to programme it as a whole

hope u wil find some time to post it
any help wil b realy aapreciable

 

[nitn28]

hello everyone

plz reply to above querry if u find time i m trying to solve it ,i
realy want to get it solved
already spent 3 days on this problem

i m learning excel vba , so plz help me out
many thanx

 

[Joel]

Had to finish something else before I got to this code. I didn't get a
chance to test the code. The code expects in row 1 in every other column
starting in column c a number. Anythin higher than the number in the last
column (F) will be placed in the last column.

A B C D E F

1 15 20 35

Sub splitcol()

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each r In MyRange
d = Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + (r.Offset(0, 1).Value))

For ColumnCount = 3 To LastCol Step 2

If ColumnCount = LastCol Then

LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount) = r.Offset(-1, 1).Value
Cells(LastRow + 1, ColumnCount + 1) = r.Value

Else
If Abs(d) >= Cells(1, ColumnCount) And _
Abs(d) < Cells(1, ColumnCount + 2) Then

LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount) = r.Offset(-1, 1).Value
Cells(LastRow + 1, ColumnCount + 1) = r.Value
Exit For
End If
End If
Next ColumnCount
Next r

End Sub

 

[nitn28]

hi Mr joel
thanx again 4 ur ind response , effort n time

i tried d code u pasted modified the equation of "d" as well

but i m geeting "error"==Run-time error "13",,,,type Mismatch

 

[Joel]

didn't means to change D equation. You have to tell me which line is failing
the error 13.

 

[nitn28]

For Each r In MyRange

this line is failing

 

[Joel]

I though you had the code for range R already writen. My code was meant to
follow the code you alrady had working. r would look something like this if
the data was in rowws A and B. Becuase you had an columnoffset in your code
0 & -1 the range r cannot include column A (A with column offset -1 would
give an error)

If data was in columns a & B
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set r = Range(Cells(2, "B"), Cells(LastRow, "B"))

 

[nitn28]

hi mr. joel
this is the code i m trying to run
but now getting different error .....run time error ----91
object variable or with block variable not set........


Sub splitcol()
Dim myRange As Range
Dim r As Range
Dim d As Variant

Set myRange = myRange.Resize(lrow, 1)
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set r = Range(Cells(2, "B"), Cells(LastRow, "B"))

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

For ColumnCount = 3 To LastCol Step 2

If ColumnCount = LastCol Then

LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount) = r.Offset(-1, 1).Value
Cells(LastRow + 1, ColumnCount + 1) = r.Value

Else
If Abs(d) >= Cells(1, ColumnCount) And _
Abs(d) < Cells(1, ColumnCount + 2) Then

LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount) = r.Offset(-1, 1).Value
Cells(LastRow + 1, ColumnCount + 1) = r.Value
Exit For
End If
End If
Next ColumnCount
Next r

End Sub

 

[Joel]

Sub newsplit()


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


For RowCount = 2 To (LastRow - 1) Step 2
d = Sqr((Cells(RowCount + 1, "A") - Cells(RowCount, "A")) ^ 2 + _
(Cells(RowCount + 1, "B") - Cells(RowCount, "B")) ^ 2)

For ColumnCount = 3 To LastCol Step 2

If ColumnCount = LastCol Then

LastRow1 = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow1 + 1, ColumnCount) = Cells(RowCount, "A")
Cells(LastRow1 + 1, ColumnCount + 1) = Cells(RowCount, "B")

Else
If Abs(d) >= Cells(1, ColumnCount) And _
Abs(d) < Cells(1, ColumnCount + 2) Then

LastRow1 = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow1 + 1, ColumnCount) = Cells(RowCount, "A")
Cells(LastRow1 + 1, ColumnCount + 1) = Cells(RowCount, "B")
Exit For
End If
End If
Next ColumnCount
Next RowCount

End Sub

 

[nitn28]

hi joel once again thanx for ur code

i tried it but its not actually wat i want to do with data ...2day is
4th day i m spending on this problem but want to solve it anyhow i m
putting my querry here aonce again

i hav divided it into two parts
plz if u progrmme these two conditions i wil b really thankful 2 u

One idea/logic to approach this problem but unable to programme it as
i am a novice

1] why dont we insert an empty cell above the value which gives
whenevr "D" > 10

"D" = Sqr((r.Value - r.Offset(-1, 0).Value) ^ 2 + (r.Offset(0,
1).Value - r.Offset(-1, 1).Value) ^ 2)

say if "D" = 11 for cell a90 , b90 & a 91 , b91 value......then insert
cell above a91 and b 91

similarly wherevr we get "d" > 10

2} Now the second part, copy all the value before first empty cel
occurs say in row a91 empty cell ocurs so code shud copy all values
above empty cell n paste the a1:b91 values in col.c n col.d [c1:d91]

like wise if again empty cell occur at a140 then copy values from
a92:b139 n paste them to col .e & col.f [E1:F47]

 

[Joel]

I did whatt you asked for. Not sure is it really makes sense. You should be
able to make some changes on your own to get it right.



Sub newsplit()
Dim myRange As Range
Dim r As Range
Dim d As Variant


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

LastEmptyRow = 2
For RowCount = 2 To (LastRow - 1) Step 2

If IsEmpty(Cells(RowCount, "A")) Then
Set EmptyRange = Range(Cells(LastEmptyRow, "A"), _
Cells(RowCount - 1, "B"))
Lastrow1 = Cells(Rows.Count, "C").End(xlUp).Row
EmptyRange.Copy Destination:=Range("C" & (Lastrow1 + 1))

Else
d = Sqr((Cells(RowCount + 1, "A") - Cells(RowCount, "A")) ^ 2 + _
(Cells(RowCount + 1, "B") - Cells(RowCount, "B")) ^ 2)

For ColumnCount = 3 To LastCol Step 2

If ColumnCount = LastCol Then

Lastrow1 = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(Lastrow1 + 1, ColumnCount) = Cells(RowCount, "A")
Cells(Lastrow1 + 1, ColumnCount + 1) = Cells(RowCount, "B")
Cells(Lastrow1 + 2, ColumnCount) = Cells(RowCount + 1, "A")
Cells(Lastrow1 + 2, ColumnCount + 1) = Cells(RowCount + 1, "B")

Else
If Abs(d) >= Cells(1, ColumnCount) And _
Abs(d) < Cells(1, ColumnCount + 2) Then

Lastrow1 = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(Lastrow1 + 1, ColumnCount) = Cells(RowCount, "A")
Cells(Lastrow1 + 1, ColumnCount + 1) = Cells(RowCount, "B")
Cells(Lastrow1 + 2, ColumnCount) = Cells(RowCount + 1, "A")
Cells(Lastrow1 + 2, ColumnCount + 1) = Cells(RowCount + 1, "B")
Exit For
End If
End If
Next ColumnCount
End If
Next RowCount

End Sub