Macro Needed To Move Specific Row To a Specific Worksheet Based On Criteria

[CONFUSED_AS_USUAL]

Hi,

I would like a macro that would:

1. Search for specific exact text in a specific column (often will be multiple matches).

2. If it encounters an exact match in that specific column, it will move the complete row to another specific worksheet (to be placed at the next available row that is not populated).

This is to cycle through until it encounters no more data.

Thanks.

 

[CONFUSED_AS_USUAL]

Assuming your using the code I wrote even though your comments were directed to Peter.

Try this script. It will delete the rows also:

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-28-17 3:14 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "CopyFrom" 'Change sheet name here
Two = "CopyTo" 'Change sheet name here
Col = "1" ' Change Column to search here
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
    
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter Field:=Col, Criteria1:=ans
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    
    End With
    
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

My apologies - and thank you for the script. Very close, except the macro breaks/stops at the line below. "Copy To" has been performed, but at this point it stops in the middle of the filter on "Copy From" and has not been deleted.

.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

 

[My Aswer Is This]

You said earlier the script worked perfectly. All I changed was the one line of code to delete the rows. Are you sure your sheets are named "CopyFrom" and "CopyTo" or modify the names like I explained earlier in my first post.

My apologies - and thank you for the script. Very close, except the macro breaks/stops at the line below. "Copy To" has been performed, but at this point it stops in the middle of the filter on "Copy From" and has not been deleted.

.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

 

[CONFUSED_AS_USUAL]

You said earlier the script worked perfectly. All I changed was the one line of code to delete the rows. Are you sure your sheets are named "CopyFrom" and "CopyTo" or modify the names like I explained earlier in my first post.

Yes, absolutely. Your notes were clear. Further, I deleted deleted the macro and pasted it back in.

Same result. Maybe that one line is causing the problem ? The error I get is "Cannot use that command on overlapping selections".

 

[My Aswer Is This]

Show me here the exact script your using that is causing you problems.

And I need to know the name of the two sheets.

The name of the copy from sheet is what???
The name of the copy to sheet is what???

 

[CONFUSED_AS_USUAL]

Show me here the exact script your using that is causing you problems.

And I need to know the name of the two sheets.

The name of the copy from sheet is what???
The name of the copy to sheet is what???

Good Morning,

Script I am using is along with the name of the two sheets are indicated below (in the script).

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-28-17 3:14 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "DGP" 'Change sheet name here
Two = "TZ ONLY" 'Change sheet name here
Col = "13" ' Change Column to search here
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")

With Worksheets(One).Rows("1:" & Lastrow)
.AutoFilter
.AutoFilter Field:=Col, Criteria1:=ans
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete


End With

ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Well I added one more line of code to be sure the script runs from Sheet named "DGP"

This script works for me.

If it still does not work please copy the line of code it errors out on and post it here in this forum.

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-29-17 1:00 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "DGP" 'Change sheet name here
Two = "TZ ONLY" 'Change sheet name here
Col = "13" ' Change Column to search here
Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
With Worksheets(One).Rows("1:" & Lastrow)
.AutoFilter
.AutoFilter Field:=Col, Criteria1:=ans
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

End With
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

 

[CONFUSED_AS_USUAL]

Well I added one more line of code to be sure the script runs from Sheet named "DGP"

This script works for me.

If it still does not work please copy the line of code it errors out on and post it here in this forum.

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-29-17 1:00 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "DGP" 'Change sheet name here
Two = "TZ ONLY" 'Change sheet name here
Col = "13" ' Change Column to search here
Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
With Worksheets(One).Rows("1:" & Lastrow)
.AutoFilter
.AutoFilter Field:=Col, Criteria1:=ans
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

End With
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

I copied and pasted the identical code. I get the same error at the same place on line:


.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Could it possibly be anything related to me using Excel 2007 ?

I appreciated the effort.

 

[Peter_SSs]

Could it possibly be anything related to me using Excel 2007 ?

Yes it could, though I am not sure this is the problem. Try changing that line to

.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp

 

[JackDanIce]

It could be the value you provided doesn't exist or cannot be filtered for on the column you specified or that there are no visible rows in the defined area to delete

 

[CONFUSED_AS_USUAL]

The line change did the trick. It now works like a charm. Thank you Peter. Also thanks to My Aswer Is This for all your effort.