Copying/Deleting Rows From Sheet To Sheet

[jgarth]

Hello All,

I've done some searching, and am finding bits and pieces of what I need, but can't seem to string anything together for the final product. What I want to do is search one sheet, in column BQ, for the word Complete. If a cell has that word in it, I want to copy that row, paste it into another sheet, and than go back and delete that row, and continue the search until all rows have been searched. Is there a simple way to do this?

I was thinking of an auto filter, but I'm not sure it'd work how I want it based off of what I've read.

Thanks in advance.

 

[brian.wethington]

Sub CopyAndDelete() 
    Dim c As Long
    Dim testvalue as String
    testvalue = "Completed" 
     
    For c = Range("B65536").End(xlUp).Row To 1 Step -1
        If Cells(c, "BQ").Value = testvalue Then 
            EndRow = Sheets("Closed Applications").Range("B1:B" & Sheets("Closed Applications").Range("B65536").End(xlUp).Row).Row + 1
            Cells(c, "BQ").EntireRow.Copy Sheets("Closed Applications").Range("A" & EndRow) 
            Cells(c, "BQ").EntireRow.Delete 
        End If 
    Next c 
End Sub

To really do this properly I need the sheet name of the shee you are copying from as well.

 

[Datsmart]

Adjusted the code.

Sub CopyAndDelete()
    Dim Rng As Range
    Dim c As Range
    Dim testvalue
    testvalue = "Completed"
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row)
    EndRow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1
    For Each c In Rng
        If c.Value = testvalue Then
        c.EntireRow.Select
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & EndRow)
            c.EntireRow.Delete
            EndRow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1
        End If
    Next c
End Sub

 

[jgarth]

Sorry, my test page did not use column BQ so I had set it up with column B instead.
I edited my post, but too late for your testing.
Stand by while I re-test using BQ.

The sheet I'm copying from is called New & Pending Applications Brian.

Datsmart, I keep getting an error while using your code.

 

[jgarth]

This code is very close to what I'm looking for. With this code, it filters out the complete's and deletes them on the pending page, but only pastes one of the completes on the new page. I need to code to take all the completedapplications and transfer them to the closed apps page, and paste them one after another, finding the next empty line down each time. Than, where they are being deleted, I do not wish to have an additional row created afterwards. It creates a blank space on the spreadsheet. Any help appreciated. Thanks to the two that have helped so far.

 

[Datsmart]

Please post the code you are using.
You have received a number versions from me and some from others too. Hard to trouble shoot without knowing what you are using.

 

[jgarth]

Sub CopyAndDelete() 
    Dim Rng As Range 
    Dim c As Range 
    Dim testvalue 
    testvalue = "Completed" 
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row) 
    EndRow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
    For Each c In Rng 
        If c.Value = testvalue Then 
        c.EntireRow.Select 
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & EndRow) 
            c.EntireRow.Delete 
            EndRow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
        End If 
    Next c 
End Sub

I'm using the code you've written.

 

[brian.wethington]

Does this work any better

Option Explicit
Option Compare Text
Sub CopyAndDelete()
Dim c As Long
Dim Endrow As Long
Dim testvalue As String

testvalue = "Completed"
For c = Sheets("New & Pending Applications").Range("BQ65536").End(xlUp).Row To 1 Step -1
    If Cells(c, "BQ").Value = testvalue Then
        Endrow = Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row + 1
        Sheets("New & Pending Applications").Cells(c, "BQ").EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow)
        Sheets("New & Pending Applications").Cells(c, "BQ").EntireRow.Delete
    End If
Next c
End Sub

 

[Datsmart]

Removed one line of code. (old test purposes)

Sub CopyAndDelete()
    Dim Rng As Range
    Dim c As Range
    Dim testvalue
    testvalue = "Completed"
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row)
    Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1
    For Each c In Rng
        If c.Value = testvalue Then
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow)
            c.EntireRow.Delete
            Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1
        End If
    Next c
End Sub

This work for me.

Brian, your code mis-assigns the EndRow variable on my test page.
Check this line:

Endrow = Sheets("Closed Applications").Range("BQ1:BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1

Try this:

Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1

 

[brian.wethington]

Endrow = Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row + 1

I am pretty sure that is all that is needed to find the next available row.

Sub CopyAndDelete() 
    Dim Rng As Range 
    Dim c As Range 
    Dim testvalue 
    testvalue = "Completed" 
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row) 
    Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
    For Each c In Rng 
        If c.Value = testvalue Then 
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow) 
            c.EntireRow.Delete 
            Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
        End If 
    Next c 
End Sub

If you have completed 2 rows in a row then it will miss one.


I am quite sure my runs in all my tests properly.

 

[Datsmart]

Brian,

Right you are, good catch on the missed row when two textvalues are in adjacent rows.

jgarth,

Use Brian's code. Be sure to update the EndRow variable like he posted above.