Hello everyone

I am new to excel vba n stucked in a problem hop i wil get help form
this forum

i hav around 2000 data in my worksheet n need to sort it out

My data is like this

1 2
3 4
5 6
7 8
9 10
13 15
15 16
17 19
19 21
28 27

as shown above i hav data in two columns wat i want to do is to copy
and paste the above values in different column based on condition say
in coulm c,d, e,f

Condition is if cell(2,1)-cell(1,1) and cell( 2,1)- cell( 2,2)
[subtraction]
3 or < -3 then copy the value of cell(2,1)&cell(1,1) in col c & col d exit for

move to next row if condition is not true then copy the range

just like this
a b c d e f g h
1 2 1 2 13 15 28 27
3 4 3 4 17 19
5 6 5 6 19 21
7 8 7 8 [these values r in
9 10 9 10 diff col. bn 13 &9,
13 15 10&15 is grtr than 3
15 16
17 19 [copied d above range
19 21 bcoz deiff is less than 3 ]
28 27

Hope sum of u get time time to help me put as i m begnr in it n trying
hard to xplore xcel - vba

many thanx

it was hard to understnad your requirements. I tried my best. This may work

Sub BinPairs()

'Let first row contain header data containing range of data in column
'Real data starts in row 2
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'columns are in pairs, so subtract 1
'subtract another 2 for last two columns
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column - 3

Set SortDataRange = Range(Cells(2, "A"), Cells(LastRow, "A"))


For Each cell In SortDataRange

'Put data in last column if doesn't fit into other columns
Inserted = False
For ColumnCount = 3 To LastCol Step 2


If (cell = Cells(1, ColumnCount)) And _
(cell < Cells(1, ColumnCount + 2)) And _
(cell.Offset(rowoffset:=0, columnoffset:=1) = _
Cells(1, ColumnCount + 1)) And _
(cell.Offset(rowoffset:=0, columnoffset:=1) < _
Cells(1, ColumnCount + 3)) Then

Inserted = True
'findlast cell in column and insert afterwards
LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount) = cell
Cells(LastRow + 1, ColumnCount + 1) = _
cell.Offset(rowoffset:=0, columnoffset:=1)
Exit For
End If

Next ColumnCount

If Inserted = False Then
'findlast cell in column and insert afterwards
LastRow = Cells(Rows.Count, ColumnCount).End(xlUp).Row
Cells(LastRow + 1, ColumnCount + 2) = cell
Cells(LastRow + 1, ColumnCount + 3) = _
cell.Offset(rowoffset:=0, columnoffset:=1)
End If

Next cell


End Sub


" wrote:

Hello everyone

I am new to excel vba n stucked in a problem hop i wil get help form
this forum

i hav around 2000 data in my worksheet n need to sort it out

My data is like this

1 2
3 4
5 6
7 8
9 10
13 15
15 16
17 19
19 21
28 27

as shown above i hav data in two columns wat i want to do is to copy
and paste the above values in different column based on condition say
in coulm c,d, e,f

Condition is if cell(2,1)-cell(1,1) and cell( 2,1)- cell( 2,2)
[subtraction]
3 or < -3 then copy the value of cell(2,1)&cell(1,1) in col c & col d exit for

move to next row if condition is not true then copy the range

just like this
a b c d e f g h
1 2 1 2 13 15 28 27
3 4 3 4 17 19
5 6 5 6 19 21
7 8 7 8 [these values r in
9 10 9 10 diff col. bn 13 &9,
13 15 10&15 is grtr than 3
15 16
17 19 [copied d above range
19 21 bcoz deiff is less than 3 ]
28 27

Hope sum of u get time time to help me put as i m begnr in it n trying
hard to xplore xcel - vba

many thanx