Cut entire row where specific cell contains a keyword and paste it into a new worksheet while shifting remaining cells up to fill in the blank spaces

Question

I am attempting to copy/paste rows from one worksheet to another if the B column contains 'Complete'. There is a drop down list in the column so I do not know if that is affecting anything but it is not copying/pasting all rows into the new worksheet. When I run it, only 4 of the 7 total rows that contain 'Complete' transfer over. This is the code I am using:


Sub TransferComplete()
    Dim o As Range
    Dim p As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("In Progress")
    Set Target = ActiveWorkbook.Worksheets("Complete")

    p = 3     ' To Start copying to row 3 in target sheet
    For Each o In Source.Range("B3:B1000")   
        If o = "Complete" Then
           Source.Rows(o.Row).Copy Target.Rows(p)
           Source.Rows(o.Row).EntireRow.Delete
           p = p + 1
        End If
    Next o
End Sub

I just want it to automatically transfer rows to the new worksheet when 'Complete' is selected from the drop down list. Any and all help is greatly appreciated!

Thank you.

Side notes: use `Long` instead of `Integer`. And if you're going to delete, you need to loop from the bottom up. — BigBen, Jan 23 '20 at 13:36
If you are looking for this to happen automatically, take a look at the [Worksheet.Change](https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.change) event. — BigBen, Jan 23 '20 at 13:48
Thank you for the assistance. Would the filter work more efficiently? — InvisibleInk, Jan 23 '20 at 13:55

score 0 · Accepted Answer · answered Jan 23 '20 at 13:45

If you're looping and deleting, you need to loop from the bottom up.

 Dim i as Long
 For i = 1000 to 3 Step -1
      If Source.Cells(i, "B").Value = "Complete" Then
           Source.Rows(i).Copy Target.Rows(p)
           Source.Rows(i).Delete
           p = p + 1
      End If
 Next

Side note: use Long instead of Integer. See this question for a detailed discussion why.

Cut entire row where specific cell contains a keyword and paste it into a new worksheet while shifting remaining cells up to fill in the blank spaces

1 Answers1