If a Cell within a range contains certain text then add text to another cell-CodePudding

I was trying to write a vba that can help detect whether within a range of cell exisit a cetain word in many sentences, but I don't know why the code did not work?

Private Sub Worksheet_Change(ByVal target As Range)
    Application.EnableEvents = False
        Set Rng = Range("Z10:Z35")
        certaintext = "Pc Owner"
        
            For Each Cell In Rng.Cells
            
            If Cell.Value Like "*" & certaintext & "*" Then
            Range("AF10") = "DONE"
            End If
            Next
            
     Application.EnableEvents = True
           
           
       
End Sub

I tried the same code in normal sub without "worksheet_change" and it works, if I want to activate this vba anytime when the worksheet changes, what should I do? Thank you!

CodePudding user response：

You can try with InStr function.

Private Sub Worksheet_Change(ByVal target As Range)
    Dim cl As Range
    Dim txt As String
    
    If Not target.Address = "$AF$10" Then
    
        Set Rng = Range("Z10:Z35")
        certaintext = "Pc Owner"
            
            For Each cl In Rng
                txt = cl.Value
                If InStr(1, txt, certaintext, vbTextCompare) > 0 Then Range("AF10") = "DONE"
            Next
            
    End If
    
End Sub

CodePudding user response：

A Worksheet Calculate: Update Column

You cannot use the Worksheet Change event if your cells contain formulas. If you can identify the column that is triggering the change in the formulas via manual entry, use this column in a Worksheet Change event.
Otherwise, you could use the Worksheet Calculate event but keep in mind that it triggers on each calculation which could slow down your worksheet.
A proper solution would require more complications e.g. involving a public array variable that would hold the values of the column and on each calculation check if any of the values have changed and only then run a modified version of the posted procedure (UpdateMyColumn). The Worksheet Open event would also need to be included to initially populate the public array.
The code is lightning fast which may not be enough because it will run too many times. Give it a try and share some feedback.

Option Explicit

Private Sub Worksheet_Calculate()
    UpdateMyColumn Me
End Sub

Sub UpdateMyColumn(ByVal ws As Worksheet)
    
    Const SRC_COLUMN_RANGE As String = "Z10:Z35" ' more than one cell!
    Const SRC_MATCH As String = "Pc Owner"
    Const DST_COLUMN As String = "AF"
    Const DST_YES_STRING As String = "DONE"
    Const DST_NO_STRING As String = ""
    
    Dim srg As Range: Set srg = ws.Range(SRC_COLUMN_RANGE)
    Dim Data() As Variant: Data = srg.Value
    
    Dim r As Long, IsMatch As Boolean
    
    For r = 1 To UBound(Data, 1)
        IsMatch = InStr(1, CStr(Data(r, 1)), SRC_MATCH, vbTextCompare) > 0
        Data(r, 1) = IIf(IsMatch, DST_YES_STRING, DST_NO_STRING)
    Next r
    
    Application.EnableEvents = False
        srg.EntireRow.Columns(DST_COLUMN).Value = Data
    Application.EnableEvents = True

End Sub