I never have a problem with someone using code I posted... it is kind of why
I post it in the first place.<g

Just a couple of comments. First, you do not need to turn off EnableEvents
during your procedure... changing the color of the parts of a cell or its
contents does not evoke a Change event. Second, I wouldn't UCase the text
when searching for "NT" as that would color the "nt" in a word that might be
on the page (such as the last 2 letters of "Bridge Tournament")... the NT
(abbreviation for No Trump) will always be in upper case. Third, just for
style, I would move all the i=i+1 statements you have inside of the If..Then
blocks to a single location in front of the If..Then statement, then delete
the i=1 and then simply change the i=i+2 statement in the "NT" block of code
to i=i+1. This is how I would have written your code...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long
On Error Resume Next
Target.Font.ColorIndex = xlColorIndexAutomatic
With Target
Do While (i <= Len(.Value))
i = i + 1
If AscW(Mid(.Value, i, 1)) = 9824 Then
.Characters(i, 1).Font.ColorIndex = 5
ElseIf AscW(Mid(.Value, i, 1)) = 9827 Then
.Characters(i, 1).Font.ColorIndex = 10
ElseIf AscW(Mid(.Value, i, 1)) = 9829 Then
.Characters(i, 1).Font.ColorIndex = 3
ElseIf AscW(Mid(.Value, i, 1)) = 9830 Then
.Characters(i, 1).Font.ColorIndex = 46
ElseIf Mid(.Value, i, 2) = "NT" Then
.Characters(i, 2).Font.ColorIndex = 44
i = i + 1
End If
Loop
End With
End Sub

By the way, I do like your treatment for applying the xlColorIndexAutomatic
condition to the font characters all at once and then just coloring the
one's that need to be changed.

--
Rick (MVP - Excel)


"keiji kounoike" <"kounoike AT mbh.nifty.com" wrote in message
...
This one is written by with reference to Rick's code without permission of
Rick. sorry, Rick.
Copy the following code into ThisWorkbook Module.

Private Sub Workbook_SheetChange _
(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long

Application.EnableEvents = False
On Error Resume Next
Target.Font.colorindex = xlColorIndexAutomatic
i = 1
With Target
Do While (i <= Len(.Value))
If AscW(Mid(.Value, i, 1)) = 9824 Then
.Characters(i, 1).Font.colorindex = 5
i = i + 1
ElseIf AscW(Mid(.Value, i, 1)) = 9827 Then
.Characters(i, 1).Font.colorindex = 10
i = i + 1
ElseIf AscW(Mid(.Value, i, 1)) = 9829 Then
.Characters(i, 1).Font.colorindex = 3
i = i + 1
ElseIf AscW(Mid(.Value, i, 1)) = 9830 Then
.Characters(i, 1).Font.colorindex = 46
i = i + 1
ElseIf UCase(Mid(.Value, i, 2)) = "NT" Then
.Characters(i, 2).Font.colorindex = 44
i = i + 2
Else
i = i + 1
End If
Loop
End With
Application.EnableEvents = True
End Sub

Keiji

Pierre62 wrote:
Sorry for asking for more....

Is it possible to make the formula work in all sheets I have in one file
or do I have to put the code in all separat sheets?
Does the code work with Office 1997?

Kind regards.
Pierre