How to find more than one word in Excel?

[man]

Hello

For example, I want to find cells that contains these 2 words [disposable] [bottles] in any order or with any other words in between, the search result shown will be A4 cell and A5 cell. How to do it? (Unable to use Ctrl+F because Ctrl+F only can search for 1 word)

My A1 cell to A6 cell contents are below
A1 cell: A water bottle is a container that is used to hold liquids, mainly water, for the purpose of transporting a drink while travelling or while otherwise away from a supply of potable water.
A2 cell: Water bottles are usually made of plastic, glass, metal, or some combination of those substances.
A3 cell: in the past, water bottles were sometimes made of wood, bark, or animal skins such as leather, hide and sheepskin.
A4 cell: Water bottles can be either disposable or reusable.
A5 cell: Disposable water bottles are often sold filled with potable water, while reusable bottles are often sold empty.
A6 cell: Reusable water bottles help cut down on consumer plastic waste and carbon emissions.

I am using Excel 2021

Thanks

 

[Cubist]

If extract all the texts to Sheet2, does it mean the original sheet data is unchanged? All the cells that matches the Find criteria will be copied to Sheet2?

Correct.

 

[Cubist]

Try this.

Sub Extract()
    Dim a, b() As Variant
    Dim i As Long, j As Long, k As Long
    Dim lastRow As Long, lastCol As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'source sheet
    Set ws2 = ThisWorkbook.Worksheets("Sheet2") 'output sheet
    
    a = ws1.Range("A1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
    
    ' Count the number of matching elements
    k = 1
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(a, 2)
            'add words here as needed with similar syntax
            If InStr(1, a(i, j), "Sold", vbTextCompare) > 0 And _
               InStr(1, a(i, j), "Disposable", vbTextCompare) > 0 And _
               InStr(1, a(i, j), "Bottles", vbTextCompare) > 0 Then
               b(k, 1) = a(i, j)
                k = k + 1
            End If
        Next j
    Next i
    
    ' Output the results to Sheet2
    ws2.Range("A1").Resize(UBound(b, 1), 1).Value = b
End Sub

 

[man]

How to use your VBA code? I never use VBA code before.

 

[Cubist]

Locate the "Developer" tab. If you don't see it then

1. On the File tab, go to Options > Customize Ribbon.
2. Under Customize the Ribbon and under Main Tabs, select the Developer checkbox

Once you have the developer tab,

1. Alt + F11. This will bring up the VB editor.
2. Insert -> Module -> Paste in the code.
3. Press F5 to execute.
4. Check the result.

 

[man]

Locate the "Developer" tab. If you don't see it then

1. On the File tab, go to Options > Customize Ribbon.
2. Under Customize the Ribbon and under Main Tabs, select the Developer checkbox

Once you have the developer tab,

1. Alt + F11. This will bring up the VB editor.
2. Insert -> Module -> Paste in the code.
3. Press F5 to execute.
4. Check the result.

After press F5, I see this Run-time error '9': Subscript out of range

 

[Cubist]

Do you have 2 sheets called Sheet1 and Sheet2?

 

[man]

Do you have 2 sheets called Sheet1 and Sheet2?

I only have 1 sheet called Sheet1

 

[Cubist]

I only have 1 sheet called Sheet1

Add a Sheet2 so it knows where to output the result.

 

[man]

Add a Sheet2 so it knows where to output the result.

Added a Sheet2 and it is working. Thanks.

If I want to search in other sheet, does it mean I rename the Sheet1 to the other sheet name that I want to search, rename Sheet1 at this row of code (shown in the next row)?
Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'source sheet

How to search within whole worksheet (all sheets in the workbook)?

Thanks

 

[Cubist]

Change your Sheet2 to Output. This code loop through all the sheets in the workbook and return the result on the Output sheet.

Sub Extract()
    Dim a, b() As Variant
    Dim i As Long, j As Long, k As Long
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    
    ' Change the name of Sheet2 to "Output"
    Set ws2 = ThisWorkbook.Worksheets("Output") ' Output sheet
    
    ' Clear previous data in the output sheet
    ws2.Cells.Clear
    
    ' Loop through each worksheet that is not named "Output"
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Output" Then
            a = ws.UsedRange.Value
            
            ' Count the number of matching elements
            For i = 1 To UBound(a, 1)
                For j = 1 To UBound(a, 2)
                    ' Add words here as needed with similar syntax
                    If InStr(1, a(i, j), "Sold", vbTextCompare) > 0 And _
                       InStr(1, a(i, j), "Disposable", vbTextCompare) > 0 And _
                       InStr(1, a(i, j), "Bottles", vbTextCompare) > 0 Then
                       ReDim Preserve b(1 To k, 1 To 1)
                       b(k, 1) = a(i, j)
                       k = k + 1
                    End If
                Next j
            Next i
        End If
    Next ws
    
    ' Output the results to the "Output" sheet
    ws2.Range("A1").Resize(UBound(b, 1), 1).Value = b
End Sub