Find Cell containing text in column and does NOT contain certain word in first 6 characters of string

Question

I am searching a column for cell that contains text and does not contain the word "cat" in the first 6 characters (needs to be case insensitive). This will then cut that entire row to another sheet. Cannot get the code to run without compile errors. the below code is before i try to change it. I do not know how to code it to look at the first 6 characters.

tried instr & iserror but i think my existing code just needs a small alteration which escapes me.

Sub CATDEFECTS()

UsdRws = Range("C" & Rows.Count).End(xlUp).Row

For i = UsdRws To 2 Step -1
        If Range("C" & i).Value Like "<>""" And Range("c" & i).Value Like "CAT" Then
            Rows(i).Cut Sheets("AWP DEFECTS").Range("A" & rows.Count).End(xlUp).Offset(1)
            Rows(i).Delete
        End If
        Next i

End Sub

Answer 1

Regardless of how you decide to implement the macro, your test to see if a cell is blank is entirely redundant. You can just test if the cell meets your CAT criteria. If it does, it is definitely not blank so no need to test it.

---

Method 1

You can look at the first 6 characters with LEFT(Range, 6)

If Left(Range("C" & i), 6) Like "*CAT*" Then

This needs Option Compare to work (Thanks @Comintern)

---

Method 2

I would prefer this method. Its explicit and does not delete or shift anything inside the loop so your action statements are greatly minimized.

Sub Cat()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<--UPDATE
Dim ps As Worksheet: Set ps = ThisWorkbook.Sheets("AWP DEFECTS")

Dim LR As Long, DeleteMe As Range, i As Long
LR = ws.Range("C" & ws.Rows.Count).End(xlUp).Row

For i = 2 To LR
    If InStr(Left(ws.Range("C" & i), 6), "CAT") Then
        If Not DeleteMe Is Nothing Then
            Set DeleteMe = Union(DeleteMe, ws.Range("C" & i))
        Else
            Set DeleteMe = ws.Range("C" & i)
        End If
    End If
Next i

Application.ScreenUpdating = False
    If Not DeleteMe Is Nothing Then
        LR = ps.Range("A" & ps.Rows.Count).End(xlUp).Row
        DeleteMe.EntireRow.Copy ps.Range("A" & LR)
        DeleteMe.EntireRow.Delete
    End If
Application.ScreenUpdating = True

End Sub

Answer 2

If cat is within the first 6 characters then InStr will report its position being less than 5.

Sub CATDEFECTS()
    dim UsdRws  as long, pos as long

    UsdRws = Range("C" & Rows.Count).End(xlUp).Row

    For i = UsdRws To 2 Step -1

        pos =instr(1, cells(i, "C").value2, "cat", vbtextcompare)

        If pos > 0 and pos < 5 Then
            Rows(i).Cut Sheets("AWP DEFECTS").Range("A" & rows.Count).End(xlUp).Offset(1)
            Rows(i).Delete
        End If

    Next i

End Sub

Answer 3

Criteria Backup (Hide/Delete)

To enable the deletion of the rows in the Source Worksheet you have to set cDEL to True in the constants section. Adjust the other constants to fit you needs.

The Code

Option Explicit
'Option Compare Text

Sub CATDEFECTS()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    On Error GoTo ProcedureExit

    ' Source Constants
    Const cSource As Variant = "Sheet1"       ' Worksheet Name/Index
    Const cCol As Variant = "C"               ' Search Column Letter/Number
    Const cFirstR As Long = 2                 ' First Row Number
    Const cChars As Long = 6                  ' Number of Chars
    Const cSearch As String = "CAT"           ' Search String
    ' Target Constants
    Const cTarget As Variant = "AWP DEFECTS"  ' Worksheet Name/Index
    Const cColTgt As Variant = "A"            ' Column Letter/Number
    Const cFirstRTgt As Long = 2              ' First Row Number
    Const cDEL As Boolean = False             ' Enable Delete (True)
    ' Variables
    Dim rngH As Range     ' Help Range
    Dim rngU As Range     ' Union Range
    Dim vntS As Variant   ' Source Array
    Dim i As Long         ' Source Range Row Counter

    ' The Criteria
    ' When the first "cChars" characters do not contain the case-INsensitive
    ' string "cSearch", the criteria is met.

    ' Source Worksheet
    With ThisWorkbook.Worksheets(cSource)
        ' Calculate Last Cell in Search Column using the Find method and
        ' assign it to Help (Cell) Range.
        Set rngH = .Columns(cCol).Find("*", , xlFormulas, _
                xlWhole, xlByColumns, xlPrevious)
        ' Calculate Source Column Range from Help (Cell) Range.
        If Not rngH Is Nothing Then   ' Last Cell was found.
            ' Calculate Source Column Range and assign it to
            ' Help (Column) Range using the Resize method.
            Set rngH = .Cells(cFirstR, cCol).Resize(rngH.Row - cFirstR + 1)
            ' Copy Help (Column) Range into 2D 1-based 1-column Source Array.
            vntS = rngH
            ' Show hidden rows to prevent  the resulting rows (the rows to be
            ' hidden or deleted) to appear hidden in Target Worksheet.
            rngH.EntireRow.Hidden = False
          Else                        ' Last Cell was NOT found (unlikely).
            MsgBox "Empty Column '" & cCol & "'."
            GoTo ProcedureExit
        End If
        ' Loop through rows of Source Array.
        For i = 1 To UBound(vntS)
            ' Check if current Source Array value doesn't meet Criteria.
            If InStr(1, Left(vntS(i, 1), cChars), cSearch, vbTextCompare) = 0 _
                    Then ' "vbUseCompareOption" if "Option Compare Text"

            ' Note: To use the Like operator instead of the InStr function
            ' you have to use (uncomment) "Option Compare Text" at the beginning
            ' of the module for a case-INsensitive search and then outcomment
            ' the previous and uncomment the following line.
'            If Not Left(vntS(i, 1), cChars) Like "*" & cSearch & "*" Then

                Set rngH = .Cells(i + cFirstR - 1, cCol)
                If Not rngU Is Nothing Then
                    ' Union Range contains at least one range.
                    Set rngU = Union(rngU, rngH)
                  Else
                    ' Union Range does NOT contain a range (only first time).
                    Set rngU = rngH
                End If
            End If
        Next
    End With

    ' Target Worksheet
    If Not rngU Is Nothing Then ' Union Range contains at least one range.
        With ThisWorkbook.Worksheets(cTarget)
            ' Calculate Last Cell in Search Column using the Find method and
            ' assign it to Help Range.
            Set rngH = .Columns(cColTgt).Find("*", , xlFormulas, _
                    xlWhole, xlByColumns, xlPrevious)
            ' Calculate Last Cell from Help Range, but in column 1 ("A").
            If Not rngH Is Nothing Then   ' Last Cell was found.
                Set rngH = .Cells(rngH.Row + 1, 1)
              Else                        ' Last Cell was NOT found.
                Set rngH = .Cells(cFirstRTgt - 1, 1)
            End If
            ' Copy the entire Union Range to Target Worksheet starting from
            ' Help Range Row + 1 i.e. the first empty row (in one go).
            ' Note that you cannot Cut/Paste on multiple selections.
            rngU.EntireRow.Copy rngH
        End With
        ' Hide or delete the transferred rows (in one go).
        If cDEL Then  ' Set the constant cDEL to True to enable Delete.
            rngU.EntireRow.Delete
          Else        ' While testing the code it is better to use Hidden.
            rngU.EntireRow.Hidden = True
        End If
    End If

ProcedureExit:

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Remarks

• The use of the array did not speed up considerably.
• The InStr function was a few milliseconds faster than the Like operator in my data set.
• Calculating the Real Used Range and copying it into a Source Array and then writing the data that meets the criteria from Source Array to a Target Array and copying the Target Array to the Target Worksheet, might be faster, and/but would additionally copy the data without formulas or formatting.