在单元格中找到单词

Question

Excel - VBA I was wondering how to find a word into a Excel range of rows using VBA. Ex. "word to be found", this is not just the cell value but a word into a string. For instance, the way to find the word "network" into the string "Need help to map network printer".

Sub SearchForSfb()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 1
   LSearchRow = 1

   'Start copying data to row 2 in Open (row counter variable)
   LCopyToRow = 2

   While Len(Range("E" & CStr(LSearchRow)).Value) > 0

      'If value in column E = "word to be found", copy entire row to Open
      If Range("E" & CStr(LSearchRow)).Value = "word to be found" Then

         'Select row in Data to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into SFB in next row
         Sheets("SFB").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         Sheets("SFB").Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Data to continue searching
         Sheets("Data").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "All matching data has been copied."

   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

Answer 1

Use a simple loop

Sub Button1_Click()
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim lstRw As Long
    Dim rng As Range
    Dim s As String
    Dim c As Range

    s = "* network *"

    Set ws = Sheets("Data")
    Set sh = Sheets("SFB")

    With ws
        lstRw = .Cells(.Rows.Count, "E").End(xlUp).Row
        Set rng = .Range("E2:E" & lstRw)
    End With

    For Each c In rng.Cells
        If c.Value Like s Then
            c.EntireRow.Copy sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next c


End Sub

Or you can use a filter macro

Sub FiltExample()
    Dim ws As Worksheet, sh As Worksheet
    Dim rws As Long, rng As Range
    Set ws = Sheets("Data")
    Set sh = Sheets("SFB")

    Application.ScreenUpdating = 0

    With ws
        rws = .Cells(.Rows.Count, "E").End(xlUp).Row
        .Range("E:E").AutoFilter Field:=1, Criteria1:="=*network*"
        Set rng = .Range("A2:Z" & rws).SpecialCells(xlCellTypeVisible)
        rng.EntireRow.Copy sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1)
        .AutoFilterMode = False
    End With

End Sub