search text for substring and change text colour of substring

[Carni]

I need to search for a substring within a text string, and if it is
present, change the colour of the text, for the substring only, to
highlight it.
For example, I have a sheet with 1 column and 200 rows containing text
strings 100 characters long. I want to find all instances of the text
string "CAT" in any cell and then change the colour of the letters CAT
wherever found. Also I need to add an index in the second column, with
a value of "1" if the substring was found in the same row or a "0" if
not found.
I know I can search for substrings and return starting positions with
worksheet functions (this could be used to build the index column) but
I do not know how to change the font colour of a substring.

 

[Don Guillett]

I need to search for a substring within a text string, and if it is
present, change the colour of the text, for the substring only, to
highlight it.
For example, I have a sheet with 1 column and 200 rows containing text
strings 100 characters long. I want to find all instances of the text
string "CAT" in any cell and then change the colour of the letters CAT
wherever found. Also I need to add an index in the second column, with
a value of "1" if the substring was found in the same row or a "0" if
not found.
I know I can search for substrings and return starting positions with
worksheet functions (this could be used to build the index column) but
I do not know how to change the font colour of a substring.

=============
Option Compare Text
Sub colorinstrtextSAS()
For Each c In Range("a1:a" & cells(rows.count,"a").endup).row)
x = InStr(c, "cat")
If x > 0 Then
c.Characters(x, 3).Font.ColorIndex = 3
c.Offset(, 1) = 1
Else
c.Offset(, 1) = 0
End If
Next
End Sub

 

[isabelle]

hi,

Sub Macro1()
s = "CAT"
With Worksheets("Feuil1")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
Set oCell = .Find(What:=s, LookIn:=xlValues, lookat:=xlPart)
If Not oCell Is Nothing Then
x = Application.Find(s, oCell)
oCell.Characters(Start:=x, Length:=3).Font.ColorIndex = 3
oCell.Offset(, 1) = 1
Adr = oCell.Address
Do
Set oCell = .FindNext(oCell)
x = Application.Find(s, oCell)
oCell.Characters(Start:=x, Length:=3).Font.ColorIndex = 3
oCell.Offset(, 1) = 1
Loop Until oCell.Address = Adr
End If
End With
End With
End Sub

 

[Carni]

=============
Option Compare Text
Sub colorinstrtextSAS()
For Each c In Range("a1:a" & cells(rows.count,"a").endup).row)
x = InStr(c, "cat")
If x > 0 Then
c.Characters(x, 3).Font.ColorIndex = 3
c.Offset(, 1) = 1
Else
c.Offset(, 1) = 0
End If
Next
End Sub

Hi, thanks for responding

the code is terminating at this line with syntax errors:

For Each c In Range("a1:a" & cells(rows.count,"a").endup).row)

There seems to be one too many closing brackets. I removed the second
last one, but I get an error saying object does not support this
property or method.

 

[Carni]

Hi, thanks for responding

the code is terminating at this line with syntax errors:

For Each c In Range("a1:a" & cells(rows.count,"a").endup).row)

There seems to be one too many closing brackets. I removed the second
last one, but I get an error saying object does not support this
property or  method.

Ok I see the problem with the first reply was a typo, should be

For Each c In Range("a1:a" & cells(rows.count,"a").end(xlUp).row)

thanks again to both responders

 

[Don Guillett]

Ok I see the problem with the first reply was a typo, should be

For Each c In Range("a1:a" & cells(rows.count,"a").end(xlUp).row)

thanks again to both responders

Sorry about the typo. Mine should be faster..