Excel VBA Find all cells containing text (partial match) and return entire row

Question

I have a large table on 'Sheet1' with thousands of rows and multiple columns.

I'd like to include a search function (similar to Excel's built in find all search that goes through the entire 'Sheet1' and returns all rows where a partial match was found (in any column).

I then want all these rows to be copied to another sheet in the document. There's already some data there in the first few rows (including the search box).

I'm using cyberponks find all function (see below) but clearly have no idea how to use it properly

Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
    Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    If Not SearchResult Is Nothing Then
        firstMatch = SearchResult.Address
        Do
            If FindAll Is Nothing Then
                Set FindAll = SearchResult
            Else
                Set FindAll = Union(FindAll, SearchResult)
            End If
            Set SearchResult = .FindNext(SearchResult)
        Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
    End If
End With
End Function

This is the code I've come up with so far

Sub Search_Button1_Click()

Dim FindWhat As String
Dim foundCells As Range
Set lblActiveX = Sheet2.Shapes("TextBox1").OLEFormat.Object
FindWhat = lblActiveX.Object.Value
Set foundCells = FindAll(Sheet1.UsedRange, FindWhat) 
        If foundCells Is Nothing Then
            Msgbox ("Value Not Found")
        Else
            For Each cell In foundCells
                cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("B9" & Rows.Count).End(xlUp).Offset(1)
            Next
        End If
End Sub

The problem with this is

It doesn't return partial matches
If a search word is found multiple times within a row, it copies the same row as many times as the word appears.

I need to be able to search in every column, but I only need the row once if any match is found.

I do have a unique ID column "A" but not sure if I should use that to return each row only once.

Have absolutely no clue as to how I can find matches if more words are entered.

So for instance if the following three words are entered "anxiety depression free" I would like the row to be returned that contains "depression" in column "B" , "anxiety" in column "C" and "free" in column D. None of these words would appear only on their own, but inside a sentence or part of a list separated by commas. Their order varies as well.

Any help would be greatly appreciated.

garbb garbb · Accepted Answer · 2020-10-25T00:05:29

1.The XlLookAt parameter can be set to xlPart to get partial matches

2.Assuming the cells in the range that is returned from Findall() is in the same order as the cells in the range that was passed as the rng parameter to Findall(), when you iterate through each cell in foundCells, store the cell.row into some variable lastfoundrow. Then for the next cell only copy that row if cell.row <> lastfoundrow:

'init as zero so it will not match cell.row the first time (row cannot be 0)
lastfoundrow = 0

For Each cell In foundCells
    If cell.row <> lastfoundrow then
        cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("B9" & Rows.Count).End(xlUp).Offset(1)

        ' only store *after* we have compared cell.row to lastfoundrow above
        lastfoundrow = cell.row
    End If
Next

Then it should skip that cell if it is in the same row as the last found cell.

3.Not sure I understand this one.

Excel VBA Find all cells containing text (partial match) and return entire row

1 Answers