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.
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.
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
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.
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.
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
Source: Stackoverflow.com