How can we look up a string in an Excel sheet? With normal Excel code it is easy using the FIND function, but when you want to use a VBA function on all results of the find operation, you'll need a custom function:
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
' occurances.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
This function returns an array of ranges containing the ranges where the searched string was in. After you can perform operations on the result values like this:
Private Sub FindAndDeleteCells()
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:D20")
FindWhat = "Large"
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
' Now we delete the cell and the 3 cells on the right
FoundCell.Cells.Activate
FoundCell.Cells.Clear
FoundCell.Offset(0, 1).Activate
FoundCell.Offset(0, 1).Clear
FoundCell.Offset(0, 2).Clear
FoundCell.Offset(0, 3).Clear
'Delete the Cells
' If you only want ot delete the cells, then use this code:
'FoundCell.Rows.Delete
'Delete the entire row
'If you want to delete the entire row then use this code:
Dim i As Long
For i = FoundCell.Rows.Count To 1 Step -1
FoundCell.Rows(i).EntireRow.Delete
Next i
Next FoundCell
End If
End Sub