Remove specific text rows and move to a separate sheet in a workbook

[leebird]

Hello,

I have a spreadsheet that I would like to identify a certain word string in a specific column and have those rows removed and placed in a separate labeled sheet in the same workbook

Sample attachment:

In the first sheet column F contains several cells that have this text "GST-P" I would like to have these rows removed from this sheet and moved to the sheet labeled "Remove GST Filing"

Any help would be greatly appreciated

Thank you very much

TEST.xlsx

[jindon]

Try

Sub test()
    Application.ScreenUpdating = False
    With Sheets("gst gl").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        .AutoFilter 6, "gst-p*"
        If .Parent.Evaluate("subtotal(3," & .Columns("f").Address & ")") > 1 Then
            .Offset(1).Copy Sheets("remove gst filing").Cells(1)
            .Offset(1).EntireRow.Delete
        Else
            MsgBox "No data to remove"
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

[leebird]

Thank you very much. It worked great. I added a few more filters to the code and the macro runs fine except at the end I'm getting the message "No Data to Remove" when there was data that was moved. I'm not sure how to edit this line to appear only when there is no action performed.

Here is the revised code.....
Thank you again.

Sub MEALSANDENTERTAINMENT()
Application.ScreenUpdating = False
With Sheets("M&E").Cells(1).CurrentRegion
.Parent.AutoFilterMode = False
.AutoFilter 5, "Employee Expense"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
End If
.AutoFilter 5, "PETTY CASH"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
End If
.AutoFilter 5, "*BMO*"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
Else
MsgBox "No data to remove"
End If
ActiveSheet.ShowAllData
End With
Application.ScreenUpdating = True
End Sub

[jindon]

..................................

[leebird]

Thank you very much. It worked great. I added a few more filters to the code and the macro runs fine except at the end I'm getting the message "No Data to Remove" when there was data that was moved. I'm not sure how to edit this line to appear only when there is no action performed.

Here is the revised code.....
Thank you again.

Sub MEALSANDENTERTAINMENT()
Application.ScreenUpdating = False
With Sheets("M&E").Cells(1).CurrentRegion
.Parent.AutoFilterMode = False
.AutoFilter 5, "Employee Expense"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
End If
.AutoFilter 5, "PETTY CASH"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
End If
.AutoFilter 5, "*BMO*"
If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
.Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
.Offset(1).EntireRow.Delete
Else
MsgBox "No data to remove"
End If
ActiveSheet.ShowAllData
End With
Application.ScreenUpdating = True
End Sub

[jindon]

No really sure how you want it...

Sub MEALSANDENTERTAINMENT()
    Dim msg As String
    Application.ScreenUpdating = False
    With Sheets("M&E").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        .AutoFilter 5, "Employee Expense"
        If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
            .Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
            .Offset(1).EntireRow.Delete
        Else
            msg = "No ""Employee Exoense"""
        End If
        .AutoFilter 5, "PETTY CASH"
        If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
            .Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
            .Offset(1).EntireRow.Delete
        Else
            msg = msg & vbf & "No ""Petty Cash"""
        End If
        .AutoFilter 5, "*BMO*"
        If .Parent.Evaluate("subtotal(3," & .Columns("e").Address & ")") > 1 Then
            .Offset(1).Copy Sheets("remove Concur & BMO").Cells(1)
            .Offset(1).EntireRow.Delete
        Else
            msg = "No ""BMO"""
        End If
        ActiveSheet.ShowAllData
    End With
    If msg Then MsgBox msg
    Application.ScreenUpdating = True
End Sub

[leebird]

That's actually even better. This works great. Thank you so much.