Macro that cut and pastes
 

I am trying to write a Macro that searches column B.
This column contains only "A's" and "B's" When it gets
to the first row that has a "B" I want it to cut that
certain cells in that row (from column A to column N) and
then paste them up in cell(2, 13)column P to (2, 25)
column AB. I want this to loop so that all of the rows
with "B" in the cell will be moved over to be along side
the data that has an "A". I have written the code for
the search to find the "B" but I can't get the cut and
paste to work. Also I need for everytime it finds a "B"
to cut it must increment downwards for those values to be
pasted.

Can anyone help me. This action happens on the active
worksheet.

Shannon

Macro that cut and pastes
 

Shannon

Try this on a backup copy of your data


Sub MoveRows()
Dim lFrom As Long
Dim lTo As Long
For lFrom = Range("a" & Rows.Count).End(xlUp).Row To 1 Step -1
If UCase(Cells(lFrom, "a")) = "B" Then
Range("a" & lFrom & ":n" & lFrom).Cut
lTo = Range("p" & Rows.Count).End(xlUp).Row + 1
Range("p" & lTo).Select
ActiveSheet.Paste
Range("a" & lFrom & ":n" & lFrom).Delete Shift:=xlUp
End If
Next

End Sub


---
Message posted from http://www.ExcelForum.com/

Macro that cut and pastes
 

I think this is what you're looking for:-

Sub TransferData()
Dim Rng As Range, C As Range
Dim Rng2 As Range, Rng3 As Range
Dim Rw As Long
Rw = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range(Cells(1, 2), Cells(Rw, 2))
For Each C In Rng
If Trim(C.Value) = "B" Then
Set Rng2 = C(1, 0).Resize(1, 14)
Set Rng3 = C(2, 15).Resize(1, 14)
Rng2.Cut Rng3
End If
Next
End Sub

Regards,
Greg

-----Original Message-----
I am trying to write a Macro that searches column B.
This column contains only "A's" and "B's" When it gets
to the first row that has a "B" I want it to cut that
certain cells in that row (from column A to column N) and
then paste them up in cell(2, 13)column P to (2, 25)
column AB. I want this to loop so that all of the rows
with "B" in the cell will be moved over to be along side
the data that has an "A". I have written the code for
the search to find the "B" but I can't get the cut and
paste to work. Also I need for everytime it finds a "B"
to cut it must increment downwards for those values to be
pasted.

Can anyone help me. This action happens on the active
worksheet.

Shannon
.

Macro that cut and pastes
 

Thank you for your help.
Shannon

-----Original Message-----
Shannon

Try this on a backup copy of your data


Sub MoveRows()
Dim lFrom As Long
Dim lTo As Long
For lFrom = Range("a" & Rows.Count).End(xlUp).Row To 1
Step -1
If UCase(Cells(lFrom, "a")) = "B" Then
Range("a" & lFrom & ":n" & lFrom).Cut
lTo = Range("p" & Rows.Count).End(xlUp).Row + 1
Range("p" & lTo).Select
ActiveSheet.Paste
Range("a" & lFrom & ":n" & lFrom).Delete Shift:=xlUp
End If
Next

End Sub


---
Message posted from http://www.ExcelForum.com/

.

Macro that cut and pastes
 

Thank you for the help.
Shannon

-----Original Message-----
I think this is what you're looking for:-

Sub TransferData()
Dim Rng As Range, C As Range
Dim Rng2 As Range, Rng3 As Range
Dim Rw As Long
Rw = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range(Cells(1, 2), Cells(Rw, 2))
For Each C In Rng
If Trim(C.Value) = "B" Then
Set Rng2 = C(1, 0).Resize(1, 14)
Set Rng3 = C(2, 15).Resize(1, 14)
Rng2.Cut Rng3
End If
Next
End Sub

Regards,
Greg

-----Original Message-----
I am trying to write a Macro that searches column B.
This column contains only "A's" and "B's" When it gets
to the first row that has a "B" I want it to cut that
certain cells in that row (from column A to column N)
and
then paste them up in cell(2, 13)column P to (2, 25)
column AB. I want this to loop so that all of the rows
with "B" in the cell will be moved over to be along side
the data that has an "A". I have written the code for
the search to find the "B" but I can't get the cut and
paste to work. Also I need for everytime it finds a "B"
to cut it must increment downwards for those values to
be
pasted.

Can anyone help me. This action happens on the active
worksheet.

Shannon
.

.

Macro that cut and pastes
 

Hello Mudraker,

I tried your suggestion and it worked, except for one
thing. It pasted the values upside down. What I need is
for once it pastes the first range of data I need it to
paste the second range of data below the first and go
down that way, rather than above. Can you help me here?

Example Before Code Example After Code
Sample number Sample number
1111 1111 2221
1112 1112 2222
1113 1113 2223
2221
2222
2223

The current code makes it look like this:
Sample number
1111 2223
1112 2222
1113 2221

Shannon



-----Original Message-----
Shannon

Try this on a backup copy of your data


Sub MoveRows()
Dim lFrom As Long
Dim lTo As Long
For lFrom = Range("a" & Rows.Count).End(xlUp).Row To 1
Step -1
If UCase(Cells(lFrom, "a")) = "B" Then
Range("a" & lFrom & ":n" & lFrom).Cut
lTo = Range("p" & Rows.Count).End(xlUp).Row + 1
Range("p" & lTo).Select
ActiveSheet.Paste
Range("a" & lFrom & ":n" & lFrom).Delete Shift:=xlUp
End If
Next

End Sub


---
Message posted from http://www.ExcelForum.com/

.

Macro that cut and pastes
 

Shannon,

Is this what you want?

Sub TransferData()
Dim Rng As Range, C As Range
Dim Rng2 As Range, Rng3 As Range
Dim DelRng As Range
Dim Rw As Long
Rw = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range(Cells(1, 2), Cells(Rw, 2))
Rw = 0
For Each C In Rng.Cells
If Trim(UCase(C.Value)) = "B" Then
Rw = Rw + 1
Set Rng2 = C(1, 0).Resize(1, 14)
Set Rng3 = Cells(Rw, 15).Resize(1, 14)
Rng3.Value = Rng2.Value
If DelRng Is Nothing Then Set DelRng = C.EntireRow _
Else Set DelRng = Union(DelRng, C.EntireRow)
End If
Next
If Not DelRng Is Nothing Then DelRng.Delete
End Sub

Regards,
Greg


-----Original Message-----
Hello Mudraker,

I tried your suggestion and it worked, except for one
thing. It pasted the values upside down. What I need is
for once it pastes the first range of data I need it to
paste the second range of data below the first and go
down that way, rather than above. Can you help me here?

Example Before Code Example After Code
Sample number Sample number
1111 1111 2221
1112 1112 2222
1113 1113 2223
2221
2222
2223

The current code makes it look like this:
Sample number
1111 2223
1112 2222
1113 2221

Shannon



-----Original Message-----
Shannon

Try this on a backup copy of your data


Sub MoveRows()
Dim lFrom As Long
Dim lTo As Long
For lFrom = Range("a" & Rows.Count).End(xlUp).Row To 1
Step -1
If UCase(Cells(lFrom, "a")) = "B" Then
Range("a" & lFrom & ":n" & lFrom).Cut
lTo = Range("p" & Rows.Count).End(xlUp).Row + 1
Range("p" & lTo).Select
ActiveSheet.Paste
Range("a" & lFrom & ":n" & lFrom).Delete Shift:=xlUp
End If
Next

End Sub


---
Message posted from http://www.ExcelForum.com/

.

.

Macro that cut and pastes
 

Thanks Greg. After sending the email I realized all I
needed to do was do a Sort function on the sample number
column right after they were all pasted. That put them
in the correct order.

Thank you again for your help. By the way, can you
recommend any good text books for a relative novice at
programming in Excel? I know a little PL/SQL, VBA, and
C++, but the books I have aren't very good. For example
I couldn't find anything in them about getting Minimum,
Maximum and Averages of cells.

Shannon

-----Original Message-----
Shannon,

Is this what you want?

Sub TransferData()
Dim Rng As Range, C As Range
Dim Rng2 As Range, Rng3 As Range
Dim DelRng As Range
Dim Rw As Long
Rw = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range(Cells(1, 2), Cells(Rw, 2))
Rw = 0
For Each C In Rng.Cells
If Trim(UCase(C.Value)) = "B" Then
Rw = Rw + 1
Set Rng2 = C(1, 0).Resize(1, 14)
Set Rng3 = Cells(Rw, 15).Resize(1, 14)
Rng3.Value = Rng2.Value
If DelRng Is Nothing Then Set DelRng = C.EntireRow _
Else Set DelRng = Union(DelRng, C.EntireRow)
End If
Next
If Not DelRng Is Nothing Then DelRng.Delete
End Sub

Regards,
Greg


-----Original Message-----
Hello Mudraker,

I tried your suggestion and it worked, except for one
thing. It pasted the values upside down. What I need
is
for once it pastes the first range of data I need it to
paste the second range of data below the first and go
down that way, rather than above. Can you help me here?

Example Before Code Example After Code
Sample number Sample number
1111 1111 2221
1112 1112 2222
1113 1113 2223
2221
2222
2223

The current code makes it look like this:
Sample number
1111 2223
1112 2222
1113 2221

Shannon



-----Original Message-----
Shannon

Try this on a backup copy of your data


Sub MoveRows()
Dim lFrom As Long
Dim lTo As Long
For lFrom = Range("a" & Rows.Count).End(xlUp).Row To 1
Step -1
If UCase(Cells(lFrom, "a")) = "B" Then
Range("a" & lFrom & ":n" & lFrom).Cut
lTo = Range("p" & Rows.Count).End(xlUp).Row + 1
Range("p" & lTo).Select
ActiveSheet.Paste
Range("a" & lFrom & ":n" & lFrom).Delete Shift:=xlUp
End If
Next

End Sub


---
Message posted from http://www.ExcelForum.com/

.

.

.

Macro that cut and pastes
 

I learned using John Walkenbauch's book:
Excel 2000 Power Programming with VBA

He has more up-to-date versions in print:
http://www.j-walk.com/ss/books/index.htm

For what it's worth, I don't like the idea of using a sort
function as you describe if only for the lack of elegance.

Regards,
Greg