Keyword Identification and Changes

[kapriano]

hi

I'm doing my job using the code below
But In fact, the words (keywords) I want to delete are in the column "c"

I mean the keyword is not just a word
I have a lot of words in the column that is added to them daily.
Is there a friend who corrects my code according to the image.

thanks


Sub Demo()
Dim dataRng As Range
Dim foundCell As Range
Dim ary() As String
On Error Resume Next
' remove empty cells
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
' group cells by "t.me/canxl/" and add name for each group
Set dataRng = ActiveSheet.UsedRange 'Range("A1:A19")
With dataRng
Set c = .Find("t.me/canxl/", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set c = .FindNext(c)
ReDim Preserve ary(i)
ary(i) = c.Row
i = i + 1
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
First = LBound(ary)
Last = UBound(ary)
For i = First To Last - 1
For j = i + 1 To Last
If ary(i) - ary(j) > 0 Then
Temp = ary(j)
ary(j) = ary(i)
ary(i) = Temp
End If
Next j
Next i
Dim xName As Name
For Each xName In Application.ActiveWorkbook.Names
xName.Delete
Next
For i = 0 To UBound(ary) - 1
ActiveWorkbook.Names.Add Name:="Group" & i + 1, RefersTo:=Range(Range("A" & ary(i)), Range("A" & ary(i + 1) - 1))
Next
ActiveWorkbook.Names.Add Name:="Group" & UBound(ary) + 1, RefersTo:=Range(Range("A" & ary(UBound(ary))), dataRng.End(xlDown))
' search which group contains keyword and delete the named range
With dataRng
Set c = .Find("Keyword", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set c = .FindNext(c)
For Each xName In Application.ActiveWorkbook.Names
If Not Intersect(c, Range(xName)) Is Nothing Then
If Rng Is Nothing Then
Set Rng = Range(xName)
Else
Set Rng = bigRange
End If
Set bigRange = Application.Union(Range(xName), Rng)
xName.Delete
End If
Next
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
bigRange.Delete
If Error.Count > 0 Then
Error.Clear
End If
End Sub

 

[pbornemeier]

Please use Excel Jeanie (or equivalent, see link in my sig) to post a portion of your worksheet and repost your code using code tags (see link in my sig) so the indenting is preserved.

 

[kapriano]

Thank you
My problem has been resolved
But I could not delete this post

 

[pbornemeier]

If you have time, please provide the solution you used so it can help others (and remember [CODE] (your code here) [/CODE] tags are everyone's friend).