FindAll Function In VBA

**Admin** · 09-13-2011, 08:15 PM

Hi All,

Here is a Function which return found range. You could use this function to delete,hide,format etc. the range. It's faster than the native Find command in VBA.

Paste this code in a standard module.

Code:

Public Enum xl_LookAt
    xl_Whole = 1
    xl_Part = 2
End Enum
Function FINDALL(ByRef RangeToLook As Range, ByVal SearchWhat As String, _
                            Optional ByVal Look_At As xl_LookAt = xl_Whole, _
                            Optional ByVal Match_Case As Boolean = False) As Range
    
    Dim r           As Long
    Dim c           As Long
    Dim UB1         As Long
    Dim UB2         As Long
    Dim strAddress  As String
    Dim k
    
    k = RangeToLook
    
    If IsArray(k) Then
        UB1 = UBound(k, 1)
        UB2 = UBound(k, 2)
        For r = 1 To UB1
            For c = 1 To UB2
                If Look_At = xl_Whole Then
                    If Match_Case Then
                        If k(r, c) = SearchWhat Then
                            strAddress = strAddress & "," & Cells(r, c).Address(0, 0)
                            If Len(strAddress) > 245 Then
                                strAddress = Mid$(strAddress, 2)
                                If FINDALL Is Nothing Then
                                    Set FINDALL = RangeToLook.Range(CStr(strAddress))
                                Else
                                    Set FINDALL = Union(FINDALL, RangeToLook.Range(CStr(strAddress)))
                                End If
                                strAddress = vbNullString
                            End If
                        End If
                    Else
                        SearchWhat = LCase$(SearchWhat)
                        If LCase$(k(r, c)) = SearchWhat Then
                            strAddress = strAddress & "," & Cells(r, c).Address(0, 0)
                            If Len(strAddress) > 245 Then
                                strAddress = Mid$(strAddress, 2)
                                If FINDALL Is Nothing Then
                                    Set FINDALL = RangeToLook.Range(CStr(strAddress))
                                Else
                                    Set FINDALL = Union(FINDALL, RangeToLook.Range(CStr(strAddress)))
                                End If
                                strAddress = vbNullString
                            End If
                        End If
                    End If
                Else
                    If Match_Case Then
                        If InStr(1, k(r, c), SearchWhat, 0) Then
                            strAddress = strAddress & "," & Cells(r, c).Address(0, 0)
                            If Len(strAddress) > 245 Then
                                strAddress = Mid$(strAddress, 2)
                                If FINDALL Is Nothing Then
                                    Set FINDALL = RangeToLook.Range(CStr(strAddress))
                                Else
                                    Set FINDALL = Union(FINDALL, RangeToLook.Range(CStr(strAddress)))
                                End If
                                strAddress = vbNullString
                            End If
                        End If
                    Else
                        SearchWhat = LCase$(SearchWhat)
                        If InStr(1, LCase$(k(r, c)), SearchWhat, 0) Then
                            strAddress = strAddress & "," & Cells(r, c).Address(0, 0)
                            If Len(strAddress) > 245 Then
                                strAddress = Mid$(strAddress, 2)
                                If FINDALL Is Nothing Then
                                    Set FINDALL = RangeToLook.Range(CStr(strAddress))
                                Else
                                    Set FINDALL = Union(FINDALL, RangeToLook.Range(CStr(strAddress)))
                                End If
                                strAddress = vbNullString
                            End If
                        End If
                    End If
                End If
            Next
        Next
        If Len(strAddress) > 1 Then
            strAddress = Mid$(strAddress, 2)
            If FINDALL Is Nothing Then
                Set FINDALL = RangeToLook.Range(CStr(strAddress))
            Else
                Set FINDALL = Union(FINDALL, RangeToLook.Range(CStr(strAddress)))
            End If
            strAddress = vbNullString
        End If
    Else
        If Look_At = xl_Whole Then
            If Match_Case Then
                If k = SearchWhat Then
                    FINDALL = RangeToLook
                End If
            ElseIf LCase$(k) = LCase$(SearchWhat) Then
                FINDALL = RangeToLook
            End If
        Else
            If Match_Case = True Then
                If InStr(1, k, SearchWhat, 0) Then
                    FINDALL = RangeToLook
                End If
            Else
                If InStr(1, LCase$(k), LCase$(SearchWhat), 0) Then
                    FINDALL = RangeToLook
                End If
            End If
        End If
    End If

End Function

and use like..

Code:

Sub kTest()
    
    Dim r As Range
    Dim c As Range, t
    
    t = Timer
    Set r = Range("a1:a50000")
    
    Set c = FINDALL(r, "k")
    
    c.Interior.Color = 255
    Debug.Print Timer - t
    
End Sub

Enjoy !!

**LalitPandey87** · 11-27-2011, 10:13 AM

So useful. its working.
Thanx Again.

**Rick Rothstein** · 02-19-2012, 02:54 AM

Here is a FindAll function that you may find useful. This function, which cannot be used as a UDF, will return a range consisting of all the cells that meet your search criteria (which you can then use directly in your code or obtain any of its parameter values, such as the Address for the range of cells) or perform an action on (such as Select them). Here is the function along with its attendant enumeration object...

Code:

Enum LookAtConstants
  xlWholeCell = xlWhole
  xlPartCell = xlPart
End Enum

Function FindAll(FindWhat As String, Optional LookAt As LookAtConstants = xlWholeCell, _
                 Optional MatchCase As Boolean = False, Optional SearchAddress As String) As Range
  Dim LastRowPlusOne As Long, RowOffset As Long, ColOffset As Long, SearchRange As Range, CopyOfSearchRange As Range
  On Error Resume Next
  If Len(SearchAddress) = 0 Then
    Set SearchRange = Selection
  Else
    Set SearchRange = Range(SearchAddress)
    If SearchRange Is Nothing Then Exit Function
  End If
  LastRowPlusOne = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row + 1
  If SearchRange Is Nothing Then Set SearchRange = Selection
  If Rows.Count - LastRowPlusOne < SearchRange.Rows.Count Then
    MsgBox "SearchRange contains too many rows!", vbCritical, "Search Range Too Large"
    Exit Function
  End If
  RowOffset = LastRowPlusOne - SearchRange(1).Row
  ColOffset = SearchRange(1).Column - 1
  Set CopyOfSearchRange = Cells(LastRowPlusOne, 1).Resize(SearchRange.Rows.Count, SearchRange.Columns.Count)
  Application.ScreenUpdating = False
  With CopyOfSearchRange
    SearchRange.Copy .Cells(1)
    .Replace FindWhat, "=" & FindWhat, LookAt, , MatchCase
    Set FindAll = .SpecialCells(xlCellTypeFormulas).Offset(-RowOffset, ColOffset)
    .Clear
  End With
  Application.ScreenUpdating = True
End Function

This function has one required argument, the FindWhat which is obviously the text you wish to search for, and three optional argument... the LookAt argument which makes uses the Enun constants xlWholeCell and xlPartCell which controls whether the text being searched for must fill the whole cell or not (the default value is xlWholeCell)... the MatchCase argument which controls whether the text being searched for must match the letter casing exactly or not (the default is False meaning the search is case insensitive)... and the SearchAddress argument which is a string value representing the address of the contiguous cell range to be searched (the default value, if omitted, is the currectly selected range of cells). Note that this function does not use any loops and, as such, should execute relatively quickly; but note that it does make use of the empty cells below the last piece of data, so the number of rows being searched must be equal to or less than the unused number of rows on the worksheet (an error will be raised if not).

Here is an example call to this function using all the arguments...

Code:

' Relying on positional arrangement
Debug.Print FindAll("cut", xlWholeCell, False, "A1:C10").Address

' Using the named arguments for clarity
Debug.Print FindAll(FindWhat:="cut", LookAt:=xlWholeCell, MatchCase:=False, SearchAddress:="A1:C10").Address