Move Entire Row to New Worksheet if Cell Contains Specific Text?

[AlexR688]

Hi everyone,

I am trying to write a macro that scans a selection of cells in one sheet and then cuts any rows from this sheet and pastes them into another sheet if the cell contains a particular text.

As it stands I have two worksheets labelled "Data" and "Errors". On the Data worksheet I have a column Labelled "Status" that will have the entries "ERROR" or "MISSING" (amongst others).

What I would like to do is, for every cell that contains either of these entries, select the entire row, cut it from the Data worksheet and paste it into the next empty row on the Errors worksheet.

The worksheets look like so:

Data:

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]Column Title 1[/TD]
[TD="align: center"]Column Title 2[/TD]
[TD="align: center"]Status[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]ERROR[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]MISSING[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]ERROR[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
</tbody>[/TABLE]


Errors (what I'd like it to look like after macro has run):

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Column Title 1[/TD]
[TD]Column Title 2[/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]text[/TD]
[TD]text[/TD]
[TD]ERROR[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]text[/TD]
[TD]text[/TD]
[TD]MISSING[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]text[/TD]
[TD]text[/TD]
[TD]ERROR[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


What I have tried so far is this (it works for the first entry but then gives the error "Select method of Range class failed"):

Option Explicit

Sub RemoveErrors()

Application.ScreenUpdating = False

Dim LastRow As Long
Dim BadRow As Range

LastRow = Cells(Rows.Count, "C").End(xlUp).Row

Sheets("Data").Select
Range("C7:C" & LastRow).Select[INDENT]
For Each BadRow In Range("C7:C" & LastRow)

Select Case BadRow.Value
[/INDENT]
[INDENT=2]
Case "ERROR"[/INDENT]
[INDENT=3]BadRow.EntireRow.Select
Selection.Cut
Sheets("Errors").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste[/INDENT]
[INDENT=2]
Case "MISSING"[/INDENT]
[INDENT=3]BadRow.EntireRow.Select
Selection.Cut
Sheets("Errors").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
[/INDENT]
[INDENT]
End Select

Next BadRow
[/INDENT]

End Sub

Any ideas where I am going wrong?

Thanks!

 

[dermie_72]

See if this code helps.

Sub AlexR688()
'For http://www.mrexcel.com/forum/excel-...worksheet-if-cell-contains-specific-text.html
'Using autofilter to Copy rows that contain centain text to a sheet called Errors
Dim LR As Long
Range("A2").EntireRow.Insert Shift:=xlDown
LR = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row
LR1 = Sheets("Error").Cells(Rows.Count, "A").End(xlUp).Row + 1
    With Sheets("Data").Range("C2:C" & LR)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="ERROR", _
        Operator:=xlOr, Criteria2:="MISSING"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Sheets("Errors").Range("A" & LR1)
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
End Sub

 

[AlexR688]

Dermie_72,

This works almost perfectly! When I run the macro, I end up with a blank row in between the column titles and the data. It looks like this:

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Column Title 1[/TD]
[TD="align: center"]Column Title 2[/TD]
[TD="align: center"]STATUS[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]BLANK[/TD]
[TD="align: center"]BLANK[/TD]
[TD="align: center"]BLANK[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]ERROR[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]MISSING[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
</tbody>[/TABLE]

Is there any way to stop this there being a blank row?

Thanks

 

[dermie_72]

The easiest way to remove the blank row would be to:
Record a macro.
Go into Sheet2
Delete the blank row
stop recording

Copy the code from the recording into the macro I provided, above the end sub, but below the end with.

 

[AlexR688]

Have done that and it works great.

Thanks for all your help!