Requirement:
Find a cell containing the word TOTAL
then to enter a dash in the cell below it.
Solution:
This solution uses the Find
method of the Range
object, as it seems appropriate to use it rather than brute force (For…Next
loop).
For explanation and details about the method see Range.Find method (Excel)
Implementation:
In order to provide flexibility the Find
method is wrapped in this function:
Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean
Where:
sWhat
: contains the string
to search for
rTrg
: is the range
to be searched
The function returns True
if any match is found, otherwise it returns False
Additionally, every time the function finds a match it passes the resulting range
to the procedure Range_Find_Action
to execute the required action, (i.e. "enter a dash in the cell below it"). The "required action" is in a separated procedure to allow for customization and flexibility.
This is how the function is called:
This test is searching for "total" to show the effect of the MatchCase:=False
. The match can be made case sensitive by changing it to MatchCase:=True
Sub Range_Find_Action_TEST()
Dim sWhat As String, rTrg As Range
Dim sMsgbdy As String
sWhat = "total" 'String to search for (update as required)
Rem Set rTrg = ThisWorkbook.Worksheets("Sht(0)").UsedRange 'Range to Search (use this to search all used cells)
Set rTrg = ThisWorkbook.Worksheets("Sht(0)").Rows(6) 'Range to Search (update as required)
sMsgbdy = IIf(Range_ƒFind_Action(sWhat, rTrg), _
"Cells found were updated successfully", _
"No cells were found.")
MsgBox sMsgbdy, vbInformation, "Range_ƒFind_Action"
End Sub
This is the Find function
Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean
Dim rCll As Range, s1st As String
With rTrg
Rem Set First Cell Found
Set rCll = .Find(What:=sWhat, After:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Rem Validate First Cell
If rCll Is Nothing Then Exit Function
s1st = rCll.Address
Rem Perform Action
Call Range_Find_Action(rCll)
Do
Rem Find Other Cells
Set rCll = .FindNext(After:=rCll)
Rem Validate Cell vs 1st Cell
If rCll.Address <> s1st Then Call Range_Find_Action(rCll)
Loop Until rCll.Address = s1st
End With
Rem Set Results
Range_ƒFind_Action = True
End Function
This is the Action procedure
Sub Range_Find_Action(rCll)
rCll.Offset(1).Value2 = Chr(167) 'Update as required - Using `§` instead of "-" for visibilty purposes
End Sub
