Keyword Identification and Changes

[kapriano]

20874
{up.persianscript.ir/uploads2/ad51-Book1.rar}
Hi
I'm doing my job using the code below
I want to open a window asking me the following variable
"Set c = .Find("t.me/canx1/", LookIn:=xlValues)"

I also enter the new or desired variable
Can friendship help?

thanks


Sub Demo()
Dim dataRng As Range
Dim foundCell As Range
Dim ary() As String
On Error Resume Next

' remove empty cells in column A
ActiveSheet.Range("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

' group cells by "t.me/canx1/" and add name for each group
Set dataRng = ActiveSheet.Range("A:A") 'column A
With dataRng
Set c = .Find("t.me/canx1/", 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
For Each cell In Range("C1", Range("C:C").End(xlDown)) ' C1 to last cell
Set c = .Find(cell.Value, 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
Next
End With

bigRange.Delete
If Error.Count > 0 Then
Error.Clear
End If
End Sub

[mdmackillop]

Please post a workbook with sample data. Go Advanced /Manage Attachments

[MINCUS1308]

kapriano, is this what you are asking?
you want to open a window and be prompted with the following question:
"What is the address of the value 't.me/canx1/' ?"