Excel regular expression macro that will search one column for matches, paste the entire row of all matches in another worksheet

Question

I need to be able to use regular expressions in an excel macro that will search through a specific column, and then copy and paste all the rows that contain matches into a new sheet.

I have found a script that will search through columns and will paste the matches into a new sheet, but I'm not certain how to modify it use regular expressions instead of a single string.

I'm thinking of using this macro to search, but I need to modify the term 'mail box' to be a regular expression term/object, but I'm not sure how to integrate that.

Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 4
   LSearchRow = 4

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

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

      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

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

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

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").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

Sub SearchForString()

    Dim RE As Object
    Dim LSearchRow As Long
    Dim LCopyToRow As Long

    On Error GoTo Err_Execute

    Set RE = CreateObject("vbscript.regexp")
    RE.Pattern = "(red|blue)"
    RE.Ignorecase = True

    LSearchRow = 4 'Start search in row 4
    LCopyToRow = 2 'Start copying data to row 2 in Sheet2 (row counter variable)

    While Len(Cells(LSearchRow, "A").Value) > 0

     If RE.Test(Cells(LSearchRow, "E").Value) Then
         ActiveSheet.Rows(LSearchRow).Copy Sheets("Sheet2").Rows(LCopyToRow)
         LCopyToRow = LCopyToRow + 1 'Move counter to next row
     End If

     LSearchRow = LSearchRow + 1

    Wend

    Range("A3").Select 'Position on cell A3
    MsgBox "All matching data has been copied."

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

Answer 2

Without major changes to your existing sub. Replace:

If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

with:

v = Range("E" & CStr(LSearchRow)).Value
If InStr(1, v, "red") > 0 Or InStr(1, v, "blue") > 0 Then