Search two words at once

Question

I can search two words for example: LED LIGHT.

I want to search at once "LED LIGHT" or "LIGHT LED" no matter where "LED" or "LIGHT" is within the text.

Replacing the "space" between the words with wildcard "*" does help searching "LED LIGHT" regardless of the words position in text, but would not search in reverse "LIGHT LED".

Dim ws As Worksheet
Dim firstWord As String
Dim secondWord As String
Dim thirdWord As String
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long

On Error GoTo Whoa

Set ws = Sheet1

firstWord = InputBox("Enter word for bullet_points", "Keyword BOX")
secondWord = InputBox("Enter word for item_name", "Keyword BOX")
thirdWord = InputBox("Enter word for product_description", "Keyword BOX")
LastRow1 = Cells(Rows.Count, 8).End(xlUp).Row + 1

If firstWord = "" Then
    ActiveSheet.Cells(LastRow1, 8).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow1, 8).Value = firstWord
End If

LastRow2 = Cells(Rows.Count, 9).End(xlUp).Row + 1
If secondWord = "" Then
    ActiveSheet.Cells(LastRow2, 9).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow2, 9).Value = secondWord
End If

LastRow3 = Cells(Rows.Count, 10).End(xlUp).Row + 1
If thirdWord = "" Then
    ActiveSheet.Cells(LastRow3, 10).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow3, 10).Value = thirdWord
End If

With ws
    If firstWord <> "" Then ReplaceText ws.Range("B17:B4001"), firstWord
    If secondWord <> "" Then ReplaceText ws.Range("C17:C4001"), secondWord
    If thirdWord <> "" Then ReplaceText ws.Range("D17:D4001"), thirdWord
End With

Exit Sub

Whoa:
    msgbox Err.Description
End Sub

Private Sub ReplaceText(rng As Range, txt As String)
Dim aCell As Range
Dim bCell As Range
Dim rngFound As Range

Set aCell = rng.Find(What:=txt, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    Set rngFound = aCell

    Do
        Set aCell = rng.FindNext(After:=aCell)
        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            Set rngFound = Union(rngFound, aCell)
        Else
            Exit Do
        End If
    Loop
End If

If Not rngFound Is Nothing Then
    rngFound.Value = "XXXXXXXXXXXXX"
End If

Answer 1

I'm afraid your intention is only partially clear. Therefore my solution below consists of two unconnected parts. In the first part the user enters 3 search words and a record is made in Sheet1 of what was entered. In the second part, the function inaptly named ReplaceText, a cell is looked for that contains all the words the user entered. Note that "" will be found in every cell. Therefore, if the user entered blanks they will have no effect on the search. What will have an effect is that "LED Lighting" will be found if "LED Light" was looked for. Please bear that in mind.

Sub Test_Replace()
    ' 010

    Dim searchWord(1 To 3) As String
    Dim Clm As Long
    Dim C As Long
    Dim i As Integer

    searchWord(1) = InputBox("Enter word for bullet_points", "Keyword BOX")
    searchWord(2) = InputBox("Enter word for item_name", "Keyword BOX")
    searchWord(3) = InputBox("Enter word for product_description", "Keyword BOX")

    Clm = 2                     ' first column to replace
    With Sheet1
        For C = 8 To 10
            i = i + 1
            If Len(searchWord(i)) = 0 Then searchWord(i) = "No INPUT"
            .Cells(.Rows.Count, C).End(xlUp).Offset(1).Value = searchWord(i)
            Clm = Clm + 1
        Next C

'        If firstWord <> "" Then ReplaceText Ws.Range("B17:B4001"), firstWord
'        If secondWord <> "" Then ReplaceText Ws.Range("C17:C4001"), secondWord
'        If thirdWord <> "" Then ReplaceText Ws.Range("D17:D4001"), thirdWord
    End With

End Sub

Private Function ReplaceText(Rng As Range, _
                             searchWord() As String) As boolean

    Dim Fnd As Range
    Dim FndVal As String
    Dim i As Integer

    Set Fnd = Rng.Find(What:=searchWord(3), LookIn:=xlValues, _
                       LookAt:=xlPart, SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False, SearchFormat:=False)
    If Not Fnd Is Nothing Then
        Do Until Fnd Is Nothing
            FndVal = Fnd.Value
            ' compare case-insensitive
            For i = 2 To 1 Step -1
                If InStr(1, FndVal, searchWord(i), vbTextCompare) = 0 Then Exit For
            Next i
            If i = 0 Then
                Set Rng = Fnd
                ReplaceText = True
                Exit Do
            End If
            Set Fnd = Rng.FindNext(Fnd)
        Loop
    End If
End Function

In the first procedure the difference between my code and yours is in the replacement of the ActiveSheet with Sheet1. Observe that the variable Clm is set up to pass the range "B17:B4001", C and D, perhaps in the loop, but I didn't manage to logically connect this.

The function looks for the 3rd word first. If that is a blank the search can take a long time because every cell in the searched range qualifies. If searchWord(3) is found the code will look for (2) and (1) and return the cell as the result if all three are found. Else the function will look for the next pre-qualified cell. You can refine the qualifying process to make sure that Delight will not be mistaken for Light.

The function returns True or False, depending upon whether a match was found. If the answer is True the Rng variable passed to it as argument will contain the address of where the match was found. Here is the function call I used in my tests.

Private Sub TestFind()
    Dim Rng As Range
    Dim Sw() As String

    Sw = Split(" One Two Three")
    Set Rng = Range("A2:A25")
    Debug.Print ReplaceText(Rng, Sw), Rng.Address
End Sub

If the function returned False Rng.Address will be "A2:A25"