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.
|
||