Using "If cell contains" in VBA excel - excel

Question

I'm trying to write a macro where if there is a cell with the word "TOTAL" then it will input a dash in the cell below it. For example:
In the case above, I would want a dash in cell F7 (note: there could be any number of columns, so it will always be row 7 but not always column F).
I'm currently using this code, but it's not working and I can't figure out why.
Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select
Selection.End(xlToRight).Select
Selection.Value = "-"
End If
Help would be appreciated. Hopefully I'm not doing something stupid.

Answer 1

This will loop through all cells in a given range that you define ("RANGE TO SEARCH") and add dashes at the cell below using the Offset() method. As a best practice in VBA, you should never use the Select method.
Sub AddDashes()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("RANGE TO SEARCH")
For Each cel In SrchRng
If InStr(1, cel.Value, "TOTAL") > 0 Then
cel.Offset(1, 0).Value = "-"
End If
Next cel
End Sub

Answer 2

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C6:ZZ6")) Is Nothing Then
If InStr(UCase(Target.Value), "TOTAL") > 0 Then
Target.Offset(1, 0) = "-"
End If
End If
End Sub
This will allow you to add columns dynamically and automatically insert a dash underneath any columns in the C row after 6 containing case insensitive "Total". Note: If you go past ZZ6, you will need to change the code, but this should get you where you need to go.

Answer 3

This does the same, enhanced with CONTAINS:
Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
Dim I As Long
Dim xRet As String
For I = 1 To LookupRange.Columns(1).Cells.Count
If InStr(1, LookupRange.Cells(I, 1), LookupValue) > 0 Then
If xRet = "" Then
xRet = LookupRange.Cells(I, ColumnNumber) & Char
Else
xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
End If
End If
Next
SingleCellExtract = Left(xRet, Len(xRet) - 1)
End Function

Answer 4

Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select
Selection.End(xlToRight).Select
Selection.Value = "-"
End If
You declared "celltxt" and used "celltext" in the instr.

Answer 5

Is this what you are looking for?
If ActiveCell.Value == "Total" Then
ActiveCell.offset(1,0).Value = "-"
End If
Of you could do something like this
Dim celltxt As String
celltxt = ActiveSheet.Range("C6").Text
If InStr(1, celltxt, "Total") Then
ActiveCell.offset(1,0).Value = "-"
End If
Which is similar to what you have.

Answer 6

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