Results 1 to 2 of 2

Thread: FindAll function

  1. #1
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13

    FindAll function

    Here is a FindAll function (not macro) 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

  2. #2
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    Hi Rock,

    Intriguing code.

    I tried to rewrite the function and to do the same thing in a macro.
    I'm not sure whether you prefer all separate address entries as result or entries the way Excel describes ranges/areas, using :

    In the macro I introduced the use of Evaluate (in the [ ] form).

    Code:
    Sub tst1()
      MsgBox findall_snb1("cut", "A1:E5", True, True)
      MsgBox findall_snb1("cut", "A1:E5", True, False)
      MsgBox findall_snb1("cut", "A1:E5", False, True)
      MsgBox findall_snb1("cut", "A1:E5", False, False)
    End Sub
    
    Function findall_snb1(c01, c02, Optional opt_1 As Boolean, Optional opt_2 As Boolean)
      ' c01 search string
      ' c02 range to be searched in
      ' opt_1 whole match=true, partial match=false
      ' opt_2 case sensitive=true, case insensitive=false
    
      For Each cl In Range(c02)
        If opt_1 And opt_2 And StrComp(cl, c01, vbTextCompare) = 0 Then findall_snb1 = findall_snb1 & "_" & cl.Address
        If opt_1 And opt_2 = False And cl = c01 Then findall_snb1 = findall_snb1 & "_" & cl.Address
        If opt_1 = False And opt_2 And InStr(cl, c01) Then findall_snb1 = findall_snb1 & "_" & cl.Address
        If opt_1 = False And opt_2 = False And InStr(1, cl, c01, vbTextCompare) Then findall_snb1 = findall_snb1 & "_" & cl.Address
      Next
    End Function
    Code:
    Sub tst2()
      findall_snb2 "cut", "A1:E5", True, True
      findall_snb2 "cut", "A1:E5", True, False
      findall_snb2 "cut", "A1:E5", False, True
      findall_snb2 "cut", "A1:E5", False, False
    End Sub
    
    Sub findall_snb2(c01, c02, opt_1, opt_2)
      ' c01 search string
      ' c02 range to be searched in
      ' opt_1 whole match=true, partial match=false
      ' opt_2 case sensitive=true, case insensitive=false
    
      Names.Add "snb_1", "=" & Chr(34) & c01 & Chr(34)
      Range(c02).Name = "snb_2"
      Names.Add "snb_3", "=" & 1 - opt_1 - 2 * opt_2
    
      sn = [if(choose(snb_3,iserror(search(snb_1,snb_2)),not(snb_1=snb_2),iserror(find(snb_1,snb_2)),not(exact(snb_1,snb_2))),"",address(row(snb_2),column(snb_2)))]
    
      For Each cl In sn
        If cl <> "" Then
          If IsEmpty(c03) Then
             Set c03 = Application.Union(Range(cl), Range(cl))
          Else
             Set c03 = Application.Union(c03, Range(cl))
          End If
        End If
      Next
    
      Debug.Print [snb_3] & "__" & c03.Address
    End Sub
    Last edited by snb; 06-12-2012 at 02:39 AM.

Similar Threads

  1. UDF (user defined function) replacement for Excel's DATEDIF function
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 21
    Last Post: 03-07-2015, 09:47 PM
  2. FindAll Function In VBA
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 4
    Last Post: 02-19-2012, 04:11 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •