looping cut & paste

[Cjluke]

:banghead:

That is how I feel.

Ok, I have a list, and the last column on this list, if populated, indicates a certain type of investment security. I need to separate the rows that have this last column populated. I want to do this by cuttting & then pasting the row into another sheet within the workbook. Here is the simple macro that does what I need:

Sub IfThen()

If Range("M4") > 0 Then Range("A4:M4").Select
Selection.Cut
Sheets("JP Morgan - VRDNs").Select
Range("A4").Select
ActiveSheet.Paste

End Sub

How do I loop this code to effectively paste all of the rows that have the last column populated into a different sheet? Here is the code I am trying to work with:

Sub Test()
Dim MyColumn As Range
Dim MyRow As Range
Dim cell As Range

Set MyColumn = Sheets("JP Morgan - Municipal").Range(Cells(4, 13), Cells(500, 13))

For Each cell In MyColumn
If cell > 0 Then _

Set MyRow = cell.Row
Sheets("JP Morgan - Municipal").Range("a:m" & MyRow).Cut

Set MyRow = Sheets("JP Morgan - VRDNs").Cells(20000, 1).End(xlUp).Offset(1, 0)
Sheets("JP Morgan - VRDNs").Range("a" & MyRow).Paste

End If
Next cell

End Sub

Any help would be appreciated...

[mdmackillop]

Hi
Welcome to VBAX
Rather than loop, use a filter
Sub Macro1()
Dim Rng As Range
Set Rng = Range(Cells(5, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 13)
With Rng
.AutoFilter Field:=13, Criteria1:="<>"
.SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Range("A1")
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

[Cjluke]

The problem is the list is already filtered using the advanced filter function. I am building the spreadsheet out to 500 rows. Also, do you have any idea if you can use advanced filters at the same time in the same worksheet?

[mdmackillop]

Can you post a workbook with sample data to show what you're trying to do?
Use Manage Attachments in the Go Advanced section.

[Cjluke]

Here is a sample of what I am trying to do...If you run the current macro it cuts and pastes the first row that has Column M populated into the sheet titled VRDNs. I would really like to be able to loop this, and I really need to learn. Any help is very appreciated...

[mdmackillop]

Here's a looping and a non-looping solution.

BTW, Using conditional formatting to change zero values text colour to white seems to me like a recipe for disaster!

Sub DoLoop()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long
Set ws1 = Sheets("Muncipals")
Set ws2 = Sheets("VRDNs")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row()
If ws1.Cells(i, "M") > 0 Then
ws1.Cells(i, "M").EntireRow.Cut ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next
ws1.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub


Sub NoLoop()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Rng As Range
Set ws1 = Sheets("Muncipals")
Set ws1 = Sheets("VRDNs")

'Define data range
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 13)

'Clear zero values from M
ws.Columns("M").AutoFilter Field:=13, Criteria1:=0
Intersect(Columns("M"), Rng).SpecialCells(xlCellTypeVisible) = ""
ws.Columns("M").AutoFilter

'Autofilter non-blanks
ws.Columns("A:M").AutoFilter Field:=13, Criteria1:="<>"
'Copy visible cells to target
Rng.SpecialCells(xlCellTypeVisible).Copy ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Delete copied rows
Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
'Remove autofilter
ws.Columns("A:M").AutoFilter
End Sub

[Cjluke]

Thanks a ton...I mean it...this has been driving me crazy!!!

[Cjluke]

Wow...you really are a VBAX Guru...VBA is so freakin' cool...any recommendations on Books I can read or sites I can visit to help me know the code any better?

[mdmackillop]

There's the course here (http://www.vbaexpress.com/training), and a lot of stuff in Resources (http://www.vbaexpress.com/resources.php). There's lots on the web, such as this (http://www.fontstuff.com/index.html)
Make use of the Macro Recorder and the VBA help file.