Rick Rothstein
02-19-2012, 02:54 AM
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...
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...
' 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
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...
' 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