CODEWITHSUNDEEP
excelvbasearchfind
Kai
Kai

Reputation: 63

Find and select all matches in worksheet

Hi all I'm trying to create a button that would find and select all matches one by one based on the value I input in cell E2. It will work somewhat like the Ctrl + Find function, whereby if I input doggo in E2, it will search through the range I specified and go to the first cell with doggo, upon the next click of the button it will go to the next cell with doggo. I got this code after researching online, however it only goes to the last cell with doggo and doesnt go in a loop from the 1st to last (e.g. if there are three doggo in different cells, could anyone assist to highlight what is what with the code?

Sub Button4_Click()
 Dim FindValue As String
 FindValue = Range("E2")
 Dim Rng As Range
 Set Rng = Range("A7:AE22")
 Dim FindRng As Range
 Set FindRng = Rng.Find(What:=FindValue)
 Dim FirstCell As String
 FirstCell = FindRng.Address
 Do
  FindRng.Select
  Set FindRng = Rng.FindNext(FindRng)
  Loop While FirstCell <> FindRng.Address
 MsgBox "Search is over"
End Sub

Upvotes: 0

Views: 218

Answers (2)

VBasic2008
VBasic2008

Reputation: 54815

Find Next Occurrence of a String in a Range

Remarks

  • The Range.Find method has many parameters so you should study it thoroughly. Afterwards you could modify ('play with') the parameters in the findCell function.
  • The 'stars of the show' are the two static variables in the findNextCell function.

Usage

  • Copy the code into a standard module e.g. Module1.
  • If you decide to use a button (Form Control), you have to assign the macro selectNext to it.
  • If you decide to use a command button (ActiveX Control), you will have to add the line selectNext to its click event code.

The Code

Option Explicit

Sub selectNext()
    
    Const CriteriaCellAddress As String = "E2"
    Const SearchRangeAddress As String = "A7:AE22"
    
    Dim Criteria As String
    Criteria = Range(CriteriaCellAddress).Value
    
    Dim SearchRange As Range
    Set SearchRange = Range(SearchRangeAddress)

    Dim cel As Range
    Set cel = findNextCell(SearchRange, Criteria)
    If Not cel Is Nothing Then
        cel.Select
    End If

End Sub

Function findNextCell(SearchRange As Range, _
                      ByVal Criteria As String) _
         As Range
    
    Static PreviousCellAddress As String
    Static CurrentCriteria As String
    
    If CurrentCriteria = "" Or CurrentCriteria <> Criteria Then
        CurrentCriteria = Criteria
    End If
    
    Dim NextCell As Range
    Set NextCell = findCell(SearchRange, CurrentCriteria, PreviousCellAddress)
    
    If Not NextCell Is Nothing Then
        ' Criteria was found.
        PreviousCellAddress = NextCell.Address
    Else
        ' Criteria was not found.
        GoTo NoRange ' Exit.
    End If
    
    Set findNextCell = NextCell
  
ProcExit:
    Exit Function

NoRange:
    Debug.Print "Could not find '" & Criteria & "' in range '" _
               & SearchRange.Address(0, 0) & "'."
    GoTo ProcExit
       
End Function

Function findCell(SearchRange As Range, _
                  ByVal Criteria As String, _
                  Optional ByVal PreviousCellAddress As String = "") _
         As Range
    
    If Criteria = "" Then
        GoTo NoCriteria ' Exit.
    End If
    
    If SearchRange Is Nothing Then
        GoTo NoRange ' Exit.
    End If
    
    Dim PreviousCell As Range
    If PreviousCellAddress <> "" Then
        Set PreviousCell = SearchRange.Worksheet.Range(PreviousCellAddress)
        If Intersect(SearchRange, PreviousCell) Is Nothing Then
            GoTo OutOfBounds ' Exit.
        End If
    Else
        Set PreviousCell = SearchRange.Cells(SearchRange.Cells.CountLarge)
    End If
    
    Set findCell = SearchRange.Find(What:=Criteria, _
                                    After:=PreviousCell, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False)

ProcExit:
    Exit Function
    
NoCriteria:
    Debug.Print "No criteria ('""')."
    GoTo ProcExit

NoRange:
    Debug.Print "No range ('Nothing')."
    GoTo ProcExit

OutOfBounds:
    Debug.Print "The cell '" & PreviousCellAddress _
              & "' is not contained in range '" & SearchRange.Address(0, 0) _
              & "'."
    GoTo ProcExit

End Function

EDIT:

In this version selectNext is different (row 7 to the last non-blank row) and it uses the getColumnsRange function:

Sub selectNext()
    
    Const CriteriaCellAddress As String = "E2"
    Const FirstRow As Long = 7
    Const ColumnsAddress As String = "A:AE"
    
    ' Define Criteria.
    Dim Criteria As String
    Criteria = Range(CriteriaCellAddress).Value
    
    ' Define Search Range (from first row to last non-blank row).
    Dim SearchRange As Range
    Set SearchRange = getColumnsRange(ActiveSheet, ColumnsAddress, FirstRow)
    
    If Not SearchRange Is Nothing Then
        ' Try to find Next Cell Range.
        Dim cel As Range
        Set cel = findNextCell(SearchRange, Criteria)
        If Not cel Is Nothing Then
            cel.Select
        End If
    End If

End Sub

Function getColumnsRange(Sheet As Worksheet, _
                         Optional ByVal ColumnsAddress As String = "A", _
                         Optional ByVal FirstRow As Long = 1) _
         As Range
    
    ' Define Last Non-Blank Cell Range.
    Dim rng As Range
    Set rng = Sheet.Columns(ColumnsAddress).Find(What:="*", _
                                                 LookIn:=xlFormulas, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlPrevious)
    ' Check Last Non-Blank Cell Range.
    If rng Is Nothing Then
        GoTo BlankColumns
    End If
    ' Check Last Non-Blank Cell Range row against First Row.
    If rng.Row < FirstRow Then
        GoTo FirstRowBelowLastRow
    End If
    ' Using the row of Last Non-Blank Cell Range, finally define Columns Range.
    Set getColumnsRange = Sheet.Range(Sheet.Columns(ColumnsAddress) _
                                           .Rows(FirstRow), _
                                      Sheet.Columns(ColumnsAddress) _
                                           .Rows(rng.Row))

ProcExit:
    Exit Function
    
BlankColumns:
    Debug.Print "The columns '" & ColumnsAddress & "' are blank."
    GoTo ProcExit

FirstRowBelowLastRow:
    Debug.Print "The last non-blank row (" & rng.Row _
              & ") is above the first row (" & FirstRow & ")."
    GoTo ProcExit
    
End Function

Upvotes: 1

MD Ismail Hosen
MD Ismail Hosen

Reputation: 118

It has just two mandatory parameter...and it will return the matched cell ranges.

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'Where search start from First cell and go to last cell.So that we say that search start after lastcell = .cells(.cells.count)
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlPart, Optional SearchOrder As XlSearchOrder = xlByRows, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
'For containing matched range.
Dim SearchResult As Range
'For first matched address.
Dim firstMatch As String
With rng
    'Find first Matched result.
    Set SearchResult = .Find(What, .Cells(.Cells.Count), LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    'If SearchResult  Nothing then set the firstmatched range address to the variable.
    If Not SearchResult Is Nothing Then
        firstMatch = SearchResult.Address
        Do
            If FindAll Is Nothing Then
                'FindAll = nothing then set FindAll = first match cell
                Set FindAll = SearchResult
            Else
                'If FindAll contain some range then union previous range with new match result range.
                Set FindAll = Union(FindAll, SearchResult)
            End If
            'Change the SearchResult to next matched cell.
            'FindNext will start from previous SearchResult address.
            Set SearchResult = .FindNext(SearchResult)
        'Loop until the SearchResult contains no address or address first address.
        Loop While Not SearchResult Is Nothing And SearchResult.Address  firstMatch
    End If
End With
End Function

Upvotes: 0

Related Questions