Search for word in a phrase

Question

I wrote the following code to loop through data column for keywords such as "personal" or "fraud" and copy rows with these keywords to a separate tab.

My code does not match when the keyword is within a phrase (e.g. "personal expenses").

Sub pooling()

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
    If Worksheets("Sheet1").Cells(i, 10).Text = "Personal" Or _
         Worksheets("Sheet1").Cells(i, 10).Text = "Fraud" Then
         Worksheets("Sheet1").Rows(i).Copy
         Worksheets("Sheet2").Activate
         b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
         Worksheets("Sheet2").Cells(b + 1, 1).Select
         ActiveSheet.Paste
         Worksheets("sheet1").Activate
    End If    
Next

End Sub

the fucntion InStr can be used to check if "this" in Cell.Value. It returns an integer value which means you check InStr(1. Cell.Value, "yourstring")>0. If its found it will be the position in which the string starts. So greater than 0 should suffice — Doug Coats, Oct 01 '18 at 00:21
i.e. "ohyeswhynot" - InStr(1, cell.value, "yes")>0= 3 b/c its starts at position 3. Make sense? — Doug Coats, Oct 01 '18 at 00:23
Thanks for advice, the following code worked for me "If InStr(.Cells(i, "J").Text, "Personal") Or _ ..." — T. Chern, Oct 02 '18 at 02:20

Shai Rado · Accepted Answer · 2018-10-01T00:29:51.743

0

Try using the Like and the wild-card *, as in the code below:

If Worksheets("Sheet1").Cells(i, 10).Value2 Like "*" & "Personal" & "*" Or _
         Worksheets("Sheet1").Cells(i, 10).Value2 Like "*" & "Fraud" & "*" Then

Full modified shorter version of your code (without using Activate)

Sub pooling()

Application.ScreenUpdating = False  ' turn off screen updating >> accelerate run time

With Worksheets("Sheet1")
    a = .Cells(.Rows.Count, 1).End(xlUp).Row

    For i = 2 To a
        If .Cells(i, 10).Value2 Like "*" & "Personal" & "*" Or _
             .Cells(i, 10).Value2 Like "*" & "Fraud" & "*" Then

             ' find last row in "Sheet2"
             b = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row

             ' copy>>paste is a 1-line syntax
             .Rows(i).Copy Destination:=Worksheets("Sheet2").Cells(b + 1, 1)
        End If
    Next i
End With

Application.ScreenUpdating = True

End Sub

edited Oct 01 '18 at 00:29

answered Oct 01 '18 at 00:24

Shai Rado

33,032
6
29
51

I think the performance of like vs Instr might be significantly different. In the middle of testing – Doug Coats Oct 01 '18 at 00:34
Maybe add an `Option Compare Binary` to show OP the difference between CI/CS (I think he wants Case Sensitive as first letter is captial) @T. Chern recognize the replaced `Select`s (avoid them, see https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba except you prepare an user-action) and the elegance of the `With` statement! – ComputerVersteher Oct 01 '18 at 00:49
Thanks, it worked and that is exactly what I looked for. – T. Chern Oct 02 '18 at 02:19

score 0 · Answer 2 · answered Oct 01 '18 at 06:18

I think it's best with AutoFilter():

Sub pooling()
    With Worksheets("Sheet1") ' reference "Sheet1" sheet
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) ' reference referenced sheet column A range from row 1 (header) to last not empty cell
            .AutoFilter field:=1, Criteria1:="*Personal*", Operator:=xlOr, Criteria2:="*Fraud*" ' filter referenced range with wanted criteria
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) ' reference referenced range offsetted one row down to skip headers
                If CBool(Application.Subtotal(103, .Cells)) Then .SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Offset(1) ' if any filtered cells then copy their entire row and paste them to "Sheet2" starting from its column A first empty row after last not empty one
            End With
        End With
        .AutoFilterMode = False
    End With
End Sub

Search for word in a phrase

2 Answers2