Need help moving row to second worksheet

[dwoychowski]

I am brand new to macros and tried using the record function, but can't get it to work properly.

I am looking to have every row with the status "Done" (column E) moved to the "Completed" tab and the remaining blank line to be deleted.

My task list starts on row 3 and goes from column B to column H.

Any help would be greatly appreciated!

 

[dwoychowski]

Try this:

Sub Filter_Me_Please()
'Modified  2/18/2020  11:13:39 AM  EST
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 5 ' Column Number Modify this to your need
s = "Done" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Completed").Rows(1)
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

This worked! I was changing more then I was supposed to, which is what caused the error. My only other question is there a way to run the macro day after day as new lines are added to worksheet 1 and have it know what is the next blank line on "completed"

 

[My Aswer Is This]

Try this:

Sub Filter_Me_Please()
'Modified  2/18/2020  12:10:54 PM  EST
Application.ScreenUpdating = False
Dim lastrow As Long
Dim lastrowa As Long
Dim c As Long
Dim s As Variant
c = 5 ' Column Number Modify this to your need
s = "Done" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
lastrowa = Sheets("Completed").Cells(Rows.Count, c).End(xlUp).Row + 1
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Completed").Rows(lastrowa)
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[dwoychowski]

Try this:

Sub Filter_Me_Please()
'Modified  2/18/2020  12:10:54 PM  EST
Application.ScreenUpdating = False
Dim lastrow As Long
Dim lastrowa As Long
Dim c As Long
Dim s As Variant
c = 5 ' Column Number Modify this to your need
s = "Done" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
lastrowa = Sheets("Completed").Cells(Rows.Count, c).End(xlUp).Row + 1
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Completed").Rows(lastrowa)
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

This perfect! Thank you again, and for you patience! Is there somewhere I can give feedback to tell everyone how awesome you are?

 

[My Aswer Is This]

This perfect! Thank you again, and for you patience! Is there somewhere I can give feedback to tell everyone how awesome you are?

Glad I was able to help you. You can click the like button if you like. Take care and have a nice day.