CODEWITHSUNDEEP
vbaexcel
MZimmerman6
MZimmerman6

Reputation: 8623

Find all matches in workbook using Excel VBA

I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches.

I currently have an implementation that works, but it is extremely slow as it is a double for loop. Of course the built in Excel Find function is "optimized" to find a single match, but I would like it to return an array of initial matches that I can then apply further methods to.

I will post some pseudocode of what I have already

For all sheets in workbook
    For all used rows in worksheet
        If cell matches search string
            do some stuff
        end
    end
end

As previously stated, this double for loop makes things run very slowly, so I am looking to get rid of this if possible. Any suggestions?

UPDATE

While the below answers would have improved my method, I ended up going with something slightly different as I needed to do multiple queries over and over.

I instead decided to loop through all rows in my document and create a dictionary containing a key for each unique row. The value this points to will then be a list of possible matches, so that when I query later, I can simply just check if it exists, and if so, just get a quick list of matches.

Basically just doing one initial sweep to store everything in a manageable structure, and then query that structure which can be done in O(1) time

Upvotes: 29

Views: 235319

Answers (7)

cyberponk
cyberponk

Reputation: 1766

Based on Ahmed's answer, after some cleaning up and generalization, including the other "Find" parameters, so we can use this function in any situation:

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
' Parameters:
'   * Same as native .Find function
'   * iDoEvents parameter: performs a DoEvents between each iteration (to keep excel from hanging in long searches)
' Notes:
'   * With Lookin= xlValues, hidden cells are not searched.
'   * What parameter has a 255 character limitation (native Excel limitation)
' Returns: a range with all matched cells found
Function FindAll(rng As Range, ByVal What As Variant, Optional LookIn As XlFindLookIn = xlFormulas, 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, Optional iDoEvents As Boolean = False) As Range
    Dim NextResult As Range, Result As Range, area As Range
    Dim FirstMatch As String
    
    If Len(What) > 255 Then Err.Raise 1, "FindAll", "Parameter 'What' must not have more than 255 characters"
    For Each area In rng.Areas
        FirstMatch = ""
        With area
            Set NextResult = .Find(What:=What, after:=.Cells(.Cells.count), LookIn:=LookIn, _
                                    LookAt:=LookAt, SearchOrder:=SearchOrder, SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            
            If Not NextResult Is Nothing Then
                FirstMatch = NextResult.Address
                Do
                    If Result Is Nothing Then
                        Set Result = NextResult
                    Else
                        Set Result = Union(Result, NextResult)
                    End If
                    Set NextResult = .FindNext(NextResult)
                    
                    If iDoEvents Then DoEvents
                Loop While Not NextResult Is Nothing And NextResult.Address <> FirstMatch
            End If
        End With
    Next
    
    Set FindAll = Result
End Function

Usage is the same as native .Find, but here is a usage example as requested:

Sub test()
  Dim SearchRange As Range, SearchResults As Range, rng As Range
    Set SearchRange = MyWorksheet.UsedRange
    Set SearchResults = FindAll(SearchRange, "Search this")
    
    If SearchResults Is Nothing Then
        'No match found
    Else
        For Each rng In SearchResults
            'Loop for each match
        Next
    End If
End Sub

Upvotes: 32

41686d6564
41686d6564

Reputation: 19661

Based on the idea of B Hart's answer, here's my version of a function that searches for a value in a range, and returns all found ranges (cells):

Function FindAll(ByVal rng As Range, ByVal searchTxt As String) As Range
    Dim foundCell As Range
    Dim firstAddress
    Dim rResult As Range
    With rng
        Set foundCell = .Find(What:=searchTxt, _
                              After:=.Cells(.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False)
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                If rResult Is Nothing Then
                    Set rResult = foundCell
                Else
                    Set rResult = Union(rResult, foundCell)
                End If
                Set foundCell = .FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    End With

    Set FindAll = rResult
End Function

To search for a value in the whole workbook:

Dim wSh As Worksheet
Dim foundCells As Range
For Each wSh In ThisWorkbook.Worksheets
    Set foundCells = FindAll(wSh.UsedRange, "YourSearchString")
    If Not foundCells Is Nothing Then
        Debug.Print ("Results in sheet '" & wSh.Name & "':")
        Dim cell As Range
        For Each cell In foundCells
            Debug.Print ("The value has been found in cell: " & cell.Address)
        Next
    End If
Next

Upvotes: 3

Nivedita Tanya
Nivedita Tanya

Reputation: 1

Below code avoids creating infinite loop. Assume XYZ is the string which we are looking for in the workbook.

   Private Sub CommandButton1_Click()
   Dim Sh As Worksheet, myCounter
   Dim Loc As Range

   For Each Sh In ThisWorkbook.Worksheets
   With Sh.UsedRange
   Set Loc = .Cells.Find(What:="XYZ")

    If Not Loc Is Nothing Then

           MsgBox ("Value is found  in " & Sh.Name)
           myCounter = 1
            Set Loc = .FindNext(Loc)

    End If
End With
Next
If myCounter = 0 Then
MsgBox ("Value not present in this worrkbook")
End If

End Sub

Upvotes: -1

B Hart
B Hart

Reputation: 1118

Function GetSearchArray(strSearch)
Dim strResults As String
Dim SHT As Worksheet
Dim rFND As Range
Dim sFirstAddress
For Each SHT In ThisWorkbook.Worksheets
    Set rFND = Nothing
    With SHT.UsedRange
        Set rFND = .Cells.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rFND Is Nothing Then
            sFirstAddress = rFND.Address
            Do
                If strResults = vbNullString Then
                    strResults = "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
                Else
                    strResults = strResults & "|" & "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
                End If
                Set rFND = .FindNext(rFND)
            Loop While Not rFND Is Nothing And rFND.Address <> sFirstAddress
        End If
    End With
Next
If strResults = vbNullString Then
    GetSearchArray = Null
ElseIf InStr(1, strResults, "|", 1) = 0 Then
    GetSearchArray = Array(strResults)
Else
    GetSearchArray = Split(strResults, "|")
End If
End Function

Sub test2()
For Each X In GetSearchArray("1")
    Debug.Print X
Next
End Sub

Careful when doing a Find Loop that you don't get yourself into an infinite loop... Reference the first found cell address and compare after each "FindNext" statement to make sure it hasn't returned back to the first initially found cell.

Upvotes: 4

WGS
WGS

Reputation: 14179

Using the Range.Find method, as pointed out above, along with a loop for each worksheet in the workbook, is the fastest way to do this. The following, for example, locates the string "Question?" in each worksheet and replaces it with the string "Answered!".

Sub FindAndExecute()

Dim Sh As Worksheet
Dim Loc As Range

For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
        Set Loc = .Cells.Find(What:="Question?")
        If Not Loc Is Nothing Then
            Do Until Loc Is Nothing
                Loc.Value = "Answered!"
                Set Loc = .FindNext(Loc)
            Loop
        End If
    End With
    Set Loc = Nothing
Next

End Sub

Upvotes: 36

Christian Fries
Christian Fries

Reputation: 16952

You may use the Range.Find method:

http://msdn.microsoft.com/en-us/library/office/ff839746.aspx

This will get you the first cell which contains the search string. By repeating this with setting the "After" argument to the next cell you will get all other occurrences until you are back at the first occurrence.

This will likely be much faster.

Upvotes: 1

Gerhard Powell
Gerhard Powell

Reputation: 6185

You can read the data into an array. From there you can do the match in memory, instead of reading one cell at a time.

Pass cell contents into VBA Array

Upvotes: -1

Related Questions