Finding Data In Worksheet Cells
|
You can use VBA to find data in a range of cells using
the Find method of a Range. Unfortunately, there is no FindAll method that
will return a Range object that contains references to all the cells in
which the searched-for text was found. This page provides such a procedure.
Another shortcoming of the Find method is that it does not support wildcard
strings. This page provides another method, WildCardMatchCells, which will
return a Range object referencing each cell whose contents match the
provided wildcard string. The wildcard string may be any string that is
valid to use with the Like operator. Search the on-line VBA Help (not Excel
Help) for "Like Operator" for a description of valid wildcarding strings. You can download the bas code module containing FindAll and WildCardMatchCells here or a complete workbook here. FindAll Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
This procedure finds all the cells in SearchRange that contain the FindWhat value. SearchRange must be a single-area range object. FindWhat is the value you want to find. All the other parameters are optional and have the same meaning as they do in the Find method of the Range object. Search VBA Help (not Excel Help) for "Find Method" for documentation on these parameters. The FindAll function returns a Range object containing references to all the cells in which FindWhat was found, subject to the values of the other parameters. If no matching cell is found, the result of the function is Nothing. Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This returns a Range object that contains all the cells in SearchRange in which FindWhat
' was found. The parameters to the function have the same meaning as they do for the
' Find method of the Range object. If no cells were found, the result of this function
' is Nothing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' In order to have Find search for the FindWhat value
' starting at the first cell in the SearchRange, we
' have to find the last cell in SearchRange and use
' that as the cell after which the Find will search.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the initial Find. If we don't find FindWhat in the first Find,
' we won't even go into the code which searches for subsequent
' occurrences.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
''''''''''''''''''''''''''''''
' Set the FoundCells range
' to the first FoundCell.
''''''''''''''''''''''''''''''
Set FoundCells = FoundCell
''''''''''''''''''''''''''''
' FirstAddr will contain the
' address of the first found
' cell. We test each FoundCell
' to this address to prevent
' the Find from looping back
' through the range it has
' already searched.
''''''''''''''''''''''''''''
FirstAddr = FoundCell.Address
Do
''''''''''''''''''''''''''''''''
' Loop calling FindNext until
' FoundCell is nothing or
' we wrap around the first
' found cell (address is in
' FirstAddr).
'''''''''''''''''''''''''''''''
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
''''''''''''''''''''
' Return the result.
''''''''''''''''''''
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
Example Usage Of FindAll Sub TestFindAll()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TestFindAll
' This is a test procedure for FindAll.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim FindWhat As Variant
Dim MatchCase As Boolean
Dim LookIn As XlFindLookIn
Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
''''''''''''''''''''''''''
' Set the variables to the
' appropriate values.
''''''''''''''''''''''''''
Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:L20")
FindWhat = "A"
LookIn = xlValues
LookAt = xlPart
SearchOrder = xlByRows
MatchCase = False
'''''''''''''''''''
' Search the range.
'''''''''''''''''''
Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
''''''''''''''''''''''
' Display the results.
''''''''''''''''''''''
If FoundCells Is Nothing Then
Debug.Print "No cells found."
Else
For Each FoundCell In FoundCells.Cells
Debug.Print FoundCell.Address, FoundCell.Text
Next FoundCell
End If
End Sub
Function WildCardMatchCells(SearchRange As Range, CompareLikeString As String, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
This procedure searches all cells in SearchRange and compares their value to the CompareLikeString using the VBA Like operator. SearchRange must be a single-area range. CompareLikeString is the pattern against which you want to compare the text of each cell. The function uses the Text property of the cell (exactly what is displayed on the screen) rather than the Value property. Search the on-line VBA Help (not Excel Help) for "Like Operator" for details about what sorts of wildcard patterns are supported by the Like function. The optional parameters SearchOrder and MatchCase have the same meaning in this procedure as they do in the Find method of the Range object. Search the on-line VBA Help (not Excel Help) for "Find Method" for a description of these parameters. The function returns a Range object containing references to all the cells that matched the CompareLikeString using the Like operator. If no matching cells were found, the result is Nothing. The module in which the function resides must not have the "Option Compare Text" directive present. If it does, case-sensitive matching will not work properly. If necessary, put this function in its own module that does not use the "Option Compare Text" directive. Because the Find method doesn't support wildcarding, the procedure loops through all the cells, so performance time may become an issue with large ranges. Moreover, if MatchCase is False, the text must be converted to upper case to do a case-insensitive match ("A" = "a"). Therefore, the procedure will be slower if MatchCase is False or omitted.
Function WildCardMatchCells(SearchRange As Range, CompareLikeString As String, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WildCardMatchCells
'
' This procedure returns the cell references whose text values match a wild card string.
' It returns all the matching cells in SearchRange that match CompareLikeString using VBA's
' LIKE operator, or returns Nothing if no matches were found or an invalid parameter
' was specified.
'
' The Find method of a Range object does not support wildcard matching when it
' compares the text of the cell with the value to find. This function support
' wildcard, any wildcarded string that is supported by the LIKE operator. See
' on-line VBA Help for "Like Operator" for a detailed description of the wildcarding
' patterns that are supported by the LIKE operator.
'
' This procedure returns a Range object containing there references of all the cells
' in SearchRange that match (using LIKE) the CompareLikeString. The SearchOrder
' parameter indicates whether the search should go across then down (SearchOrder:=xlByRows
' searches row 1 then row 2 then row 3 etc) or down then across (SearchOrder:=xlByColumns
' search column 1 then column 2 then column 3 etc). MatchCase indicates whether the case
' in case-sensitive (MatchCase:=True, "A" <> "a") or case-insensitive (MatchCase:=False,
' "A" = "a").
'
' This code loops through each cell in SearchRange rather than using Find and uses the
' Like operator rather than StrComp (which support wildcarding), so performance may be
' an issue. Note that setting MatchCase to True adds additional processing (values must
' be converted to upper case), so doing a case-insensitive search takes longer than
' a case-sensitive search.
'
' You must NOT have "Option Compare Text" specified in the module. If you have this
' directive, the case-insensitive comparisons will not work properly. If necessary,
' include this procedure in its own module.
'
' Comparison is done with the Text property of each cell, not the Value property of
' each cell. This compares to exactly what is displayed on the screen, not the underlying
' value of the cell.
'
' The function returns a Range object containing references to all the cells that
' matched the CompareLikeString test. If no matching cells were found, the result is
' Nothing. If SearchRange is nothing or has mutliple Areas, the function returns Nothing.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCells As Range
Dim FirstCell As Range
Dim LastCell As Range
Dim RowNdx As Long
Dim ColNdx As Long
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Long
Dim EndCol As Long
Dim WS As Worksheet
Dim Rng As Range
''''''''''''''''''''''''''''''
' Ensure SearchRange is not
' Nothing, and that it has a
' single area.
''''''''''''''''''''''''''''''
If SearchRange Is Nothing Then
Exit Function
End If
If SearchRange.Areas.Count > 1 Then
Exit Function
End If
With SearchRange
''''''''''''''''''''''''''''''''''
' Get the Worksheet and first and
' last cells of SearchRange.
''''''''''''''''''''''''''''''''''
Set WS = .Worksheet
Set FirstCell = .Cells(1)
Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''
' Set the row and column values
' used in the loops.
'''''''''''''''''''''''''''''''
StartRow = FirstCell.Row
StartCol = FirstCell.Column
EndRow = LastCell.Row
EndCol = LastCell.Column
If SearchOrder = xlByRows Then
'''''''''''''''''''''''''''''''''
' We're searching row-by-row,
' across then down.
'''''''''''''''''''''''''''''''''
With WS
''''''''''''''''''''''''''
' Loop through the rows.
''''''''''''''''''''''''''
For RowNdx = StartRow To EndRow
'''''''''''''''''''''''''''''''''
' In each row, loop through the
' columns.
'''''''''''''''''''''''''''''''''
For ColNdx = StartCol To EndCol
Set Rng = .Cells(RowNdx, ColNdx)
If MatchCase = False Then
'''''''''''''''''''''''''''''''''''
' If MatchCase is False, we have
' to convert the strings to Upper
' case in order to ignore the
' case of the characters. This
' conversion to upper case is why
' MatchCase:=False is slower than
' MatchCase:=True.
'''''''''''''''''''''''''''''''''''
If UCase(Rng.Text) Like UCase(CompareLikeString) Then
If FoundCells Is Nothing Then
Set FoundCells = Rng
Else
Set FoundCells = Application.Union(FoundCells, Rng)
End If
End If
Else
''''''''''''''''''''''''''''''''''''''''''''''''
' MatchCase is True. We don't need
' to convert to upper case to do the
' comparisons. Not doing the upper
' case conversion is why MatchCase
' = True if faster than when it is
' False. This conversion is also why
' you must NOT have "Option Compare Text"
' specified in the module. If it is specified
' case is ignored, which is not what we
' want here.
''''''''''''''''''''''''''''''''''''''''''''''''
If Rng.Text Like CompareLikeString Then
If FoundCells Is Nothing Then
Set FoundCells = Rng
Else
Set FoundCells = Application.Union(FoundCells, Rng)
End If
End If ' Like
End If ' MatchCase
Next ColNdx
Next RowNdx
End With
Else
''''''''''''''''''''''''''''''''''''''''''
' We're searching by column-by-column,
' down then across.
''''''''''''''''''''''''''''''''''''''''''
With WS
''''''''''''''''''''''''''
' Loop through the column.
''''''''''''''''''''''''''
For ColNdx = StartCol To EndCol
'''''''''''''''''''''''''''''''''
' In each column, loop through the
' rows.
'''''''''''''''''''''''''''''''''
For RowNdx = StartRow To EndRow
Set Rng = .Cells(RowNdx, ColNdx)
If MatchCase = False Then
'''''''''''''''''''''''''''''''''''
' If MatchCase is False, we have
' to convert the strings to Upper
' case in order to ignore the
' case of the characters. This
' conversion to upper case is why
' MatchCase:=False is slower than
' MatchCase:=True.
'''''''''''''''''''''''''''''''''''
If UCase(Rng.Text) Like UCase(CompareLikeString) Then
If FoundCells Is Nothing Then
Set FoundCells = Rng
Else
Set FoundCells = Application.Union(FoundCells, Rng)
End If
End If
Else
''''''''''''''''''''''''''''''''''''''''''''''''
' MatchCase is True. We don't need
' to convert to upper case to do the
' comparisons. Not doing the upper
' case conversion is why MatchCase
' = True if faster than when it is
' False. This conversion is also why
' you must NOT have "Option Compare Text"
' specified in the module. If it is specified
' case is ignored, which is not what we
' want here.
''''''''''''''''''''''''''''''''''''''''''''''''
If Rng.Text Like CompareLikeString Then
If FoundCells Is Nothing Then
Set FoundCells = Rng
Else
Set FoundCells = Application.Union(FoundCells, Rng)
End If
End If ' Like
End If ' MatchCase
Next RowNdx
Next ColNdx
End With
End If ' SearchOrder
'''''''''''''''''''''
' Set the Result
'''''''''''''''''''''
If FoundCells Is Nothing Then
Set WildCardMatchCells = Nothing
Else
Set WildCardMatchCells = FoundCells
End If
End Function
Example Usage Of WildCardMatchCells Sub TestWildCardMatchCells()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TestWildCardMatchCells
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim CompareLikeString As String
Dim SearchOrder As XlSearchOrder
Dim MatchCase As Boolean
''''''''''''''''''''''''''
' Set the variables to
' appropriate values.
''''''''''''''''''''''''''
Set SearchRange = Range("A1:IV65000")
CompareLikeString = "A?C*"
SearchOrder = xlByRows
MatchCase = True
''''''''''''''''''''''''
' Find the cells
''''''''''''''''''''''''
Set FoundCells = WildCardMatchCells(SearchRange:=SearchRange, CompareLikeString:=CompareLikeString, _
SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If FoundCells Is Nothing Then
Debug.Print "No cells found."
Else
For Each FoundCell In FoundCells
Debug.Print FoundCell.Address, FoundCell.Text
Next FoundCell
End If
End Sub
You can download the bas code module containing FindAll and WildCardMatchCells here or a complete workbook here.
|
||