Need Help: highlight all the same strings in one cell

[Cheng]

Dear all,

I am trying to highlight all the same strings in one Excel cell.

For example, if the following text in one Excel cell,

Wish you all a wonderful wonderful weekend!

Using Gord Dibben's macro posted on Sep 19 2006 in this group (Please
see the following for details), only the first wonderful will be
highlighted.

Could someone share your expertise to let me know how to highlight the
second wonderful, i.e., all the same strings in one cell? Many thanks!
.....Cheng

------------------------------------
Option Compare Text
Sub Highlight_Word()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer
On Error GoTo endit
myword = InputBox("Enter the search string ")
If myword = "" Then Exit Sub
Mylen = Len(myword)
Set rng = ActiveSheet.UsedRange
rng.Cells.Font.ColorIndex = 0
For Each cell In rng
start_str = InStr(cell.Value, myword)
If start_str Then
cell.Characters(start_str, Mylen).Font.ColorIndex = 3
End If
Next cell
endit:
End Sub

 

[Bob Phillips]

Sub Highlight_Word()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer
Dim myword As String
Dim Mylen As Long

On Error GoTo endit
myword = InputBox("Enter the search string ")
If myword = "" Then Exit Sub
Mylen = Len(myword)
Set rng = ActiveSheet.UsedRange
rng.Cells.Font.ColorIndex = 0
For Each cell In rng
start_str = 0
Do
start_str = InStr(start_str + 1, cell.Value, myword)
If start_str Then
cell.Characters(start_str, Mylen).Font.ColorIndex = 3
End If
Loop Until start_str = 0
Next cell
endit:
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Toppers]

Try:

Option Compare Text
Sub Highlight_Word()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer
On Error GoTo endit
myword = InputBox("Enter the search string ")
If myword = "" Then Exit Sub
mylen = Len(myword)
Set rng = ActiveSheet.UsedRange
rng.Cells.Font.ColorIndex = 0
For Each cell In rng
str_pos = 1
Do
start_str = InStr(str_pos, cell.Value, myword)
If start_str Then
cell.Characters(start_str, mylen).Font.ColorIndex = 3
Else
Exit Sub
End If
str_pos = start_str + mylen + 1
Loop Until str_pos >= Len(cell)
Next cell
endit:
End Sub

 

[Cheng]

Sub Highlight_Word()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer
Dim myword As String
Dim Mylen As Long

On Error GoTo endit
myword = InputBox("Enter the search string ")
If myword = "" Then Exit Sub
Mylen = Len(myword)
Set rng = ActiveSheet.UsedRange
rng.Cells.Font.ColorIndex = 0
For Each cell In rng
start_str = 0
Do
start_str = InStr(start_str + 1, cell.Value, myword)
If start_str Then
cell.Characters(start_str, Mylen).Font.ColorIndex = 3
End If
Loop Until start_str = 0
Next cell
endit:
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)












- Show quoted text -

Hi Toppers and Bob,

Thank you very much for your help! Really appreciate!

Bob's macro works very well. Maybe I am wrong here but Toppers' didn't
highlight the searched strings.

Have a wonderful weekend!
Cheng

 

[Toppers]

It did when I tested it! .... but stick with Bob ..he's the real guru!

 

[Don Guillett]

try?

Sub hilitewords()
mw = "wonderful"
l = Len(mw)
For Each c In Selection
mc = InStr(c, mw)
If mc > 0 Then c.Characters(mc, l).Font.ColorIndex = 3
scc = InStr(Right(c, Len(c) - mc), mw)
If scc > 0 Then c.Characters(mc + scc, l).Font.ColorIndex = 3
Next c
End Sub

 

[Don Guillett]

Although Bob's is much better than mine when looking for xx, in this xxx was
hilited instead of just xx.
aaaxxaaaxaaaxxxaaa