modification for multiple string search-CodePudding

My code searches for custom text and highlights the rows containg the user specified text/ search string.

How do I modify it so it searches for multiple strings?

    Dim Rng As Range
    Dim myCell As Object
    Dim myUnion As Range
    Set Rng = Selection
 searchString = InputBox("Please Enter the Search String")
 For Each myCell In Rng
 If InStr(myCell.Text, searchString) Then
      If Not myUnion Is Nothing Then
          Set myUnion = Union(myUnion, myCell.EntireRow)
      Else
          Set myUnion = myCell.EntireRow
      End If
 End If
 Next
 If myUnion Is Nothing Then
     MsgBox "The text was not found in the selection"
 Else
     myUnion.Select
 End If
 End Sub

CodePudding user response：

Please, try the next adapted code. You should place the strings to be searched separated by comma:

Sub searchStringS()
    Dim Rng As Range, myUnion As Range, searchString As String
    Dim myCell As Range, arrSrc, El
    
    Set Rng = Selection
    If TypeName(Rng) <> "Range" Then MsgBox "You must select a range...", vbCritical, "Wrong selection": Exit Sub
    
   searchString = InputBox("Please Enter the Search Strings, separated by comma!")
   searchString = Replace(searchString, ", ", ",") 'to eliminate eventual ", " instead of only ","...
   
   arrSrc = Split(searchString, ",")
   For Each El In arrSrc
        For Each myCell In Rng
            If InStr(myCell.Text, El) Then
                 If Not myUnion Is Nothing Then
                     Set myUnion = Union(myUnion, myCell.EntireRow)
                 Else
                     Set myUnion = myCell.EntireRow
                 End If
            End If
        Next
  Next El
  If myUnion Is Nothing Then
       MsgBox "The text was not found in the selection"
   Else
       myUnion.Select
   End If
End Sub

CodePudding user response：

Another way to do this, using ParamArray:

Public Sub fnTestSearch()
    Call fnSearchMultipleStrings("01", "2022", "A", "B", "V")
End Sub

Public Sub fnSearchMultipleStrings(ParamArray aArgumentsArray() As Variant)
    Dim vArg As Variant
    Dim rngMyCell As Excel.Range
    Dim rngMyUnion As Excel.Range
    
    For Each vArg In aArgumentsArray
        For Each rngMyCell In Selection
            If InStr(rngMyCell.Text, vArg) Then
                If Not rngMyUnion Is Nothing Then
                    Set rngMyUnion = Union(rngMyUnion, rngMyCell.EntireRow)
                Else
                    Set rngMyUnion = rngMyCell.EntireRow
                End If
            End If
        Next
    Next vArg
    
    If rngMyUnion Is Nothing Then
        MsgBox "The text was not found in the selection"
    Else
        rngMyUnion.Select
    End If
    
End Sub