Looping in text filter

Question

I have this code which cuts and pastes an entire row to another sheet. When i set values as = it works, but when i set to like or contains, the loop doesnt happen. The value of the filter i'm looking for would keep changing including with a unique phrase. Eg: 1. Overlap error: 1234, 1. Overlap error:1235 etc.

Sub loopMe()

Dim sh As Worksheet, ws As Worksheet
Dim LstR As Long, rng As Range, c As Range

Set sh = Sheets("Sheet1")    'set the sheet to loop
Set ws = Sheets("Sheet2")    'set the sheet to paste
With sh    'do something with the sheet
    LstR = .Cells(.Rows.Count, "BE").End(xlUp).Row    'find last row
    Set rng = .Range("BE5:BE" & LstR)    'set range to loop
End With

'start the loop
For Each c In rng.Cells
    'If c = "1. Overlap error:" Then
    If c.Value Like "*1. Overlap error:*" Then
    'If Left(c.Value, 17) = "1. Overlap error:" Then
    'If InStr(1, c, "1. Overlap error:") > 0 Then
        c.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)    'copy row to first empty row in sheet2
        c.EntireRow.Delete Shift:=xlUp
    End If
Next c
End Sub

Hi Santana. `Sheets("Sheet1")` is no problem? You said it runs but when there is no space between Sheet and # that is often in the form `Sheet1.Range...` since that is how excel names sheets internally. So you named your Worksheets to match the internal CodeNames? — klausnrooster, Sep 13 '20 at 13:10
Related: https://stackoverflow.com/questions/41477794/refer-to-sheet-using-codename — klausnrooster, Sep 13 '20 at 13:11
I would assume the problem is, you are deleting rows from the top down and rows are getting skipped. I ran your code, if found the values. You need to delete rows starting from the bottom. — Davesexcel, Sep 13 '20 at 13:17
Using `Set sh = Sheet1` and `Set ws = Sheet2` runs for me. But it's not a given that your Sheet1 points to Sheets("Sheet1"). And @Davesexcel is right. You should replace your `For each c in rng.Cells` loop with a `For irow = sh.Rows.Count to 5 Step -1` loop. — klausnrooster, Sep 13 '20 at 13:21
I figured the problem was, it processed only 50% of the available records and skipped the rest. I had to re-run every-time. So i did it in two parts, 1. i cut and pasted in the next sheet and 2. empty rows delete — Santana87, Sep 14 '20 at 13:33
Of course it only did it 50% of the time, I told you it was going to skip rows because you started from the top. — Davesexcel, Sep 17 '20 at 16:10

score 1 · Answer 1 · answered Sep 13 '20 at 13:24

1

You can use a filter to find the data, move it and delete the rows.

    Sub ed()
    Dim sh As Worksheet, ws As Worksheet
    Dim rng As Range

    Set sh = Sheets("Sheet1")
    Set ws = Sheets("Sheet2")
    
    With sh
        .Range("BE4").AutoFilter Field:=1, Criteria1:= _
                                 "=*1. Overlap error:*", Operator:=xlAnd
        Set rng = .Range("BE5:BE" & .Cells(.Rows.Count, "BE").End(xlUp).Row)
    
        With ws
            rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        End With
        rng.EntireRow.Delete
        .AutoFilterMode = False
    End With



End Sub

answered Sep 13 '20 at 13:24

Davesexcel

6,896
2
27
42

For Each c In rng.Cells If Left(c.Value, 17) = "1. Overlap error:" Then c.EntireRow.Cut ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) Next c On Error Resume Next rng.Select Selection.SpecialCells(xlBlanks).EntireRow.Delete – Santana87 Sep 14 '20 at 13:38
Is your comment a question? – Davesexcel Sep 16 '20 at 15:56

score 1 · Answer 2 · answered Sep 13 '20 at 14:08

So if you prefer your original approach,

Sub loopMe()

Dim sh As Worksheet, ws As Worksheet
Dim LstR As Long, c As Range

Set sh = Sheets("Sheet1")
Set ws = Sheets("Sheet2")
        'find last row
LstR = sh.Range("BE65000").End(xlUp).Row

Dim irow
For irow = LstR To 5 Step -1
    Set c = sh.Range("BE" & irow)
    If c.Value Like "*1. Overlap error:*" Then
        'copy row to first empty row in sheet2
        c.EntireRow.Copy ws.Cells(65000, 1).End(xlUp).Offset(1, 0)
        c.EntireRow.Delete Shift:=xlUp
    End If
Next irow
End Sub

Looping in text filter

2 Answers2