Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once in
the cells? If so, then the following will fix it although you probably do not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

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

Hi Pierre62:

Getting symbols into VBA can be tedious. Lets use some cells to help us.
In Z1 thru Z4 we first enter:

™£
™¦
™¥
™*


and then an update to your poste code:

Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Integer, j As Integer, v As Variant, L As Integer


strToFind = Range("Z4").Value
lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
v = foundCell.Value
L = Len(v)
For i = 1 To L
startPos = InStr(i, v, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbBlue
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub


Should give you blue ™*

--
Gary''s Student - gsnu200840


"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once in
the cells? If so, then the following will fix it although you probably do not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are they
text characters from a font (if so, which one) or something else (if so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once
in
the cells? If so, then the following will fix it although you probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Hello Garrys'student.

I indeed get blue spades.
So the next step would be to get the other symbols also in the right color.
And is it possible to make the script work for aal worksheets in my workbook
with over 50 worksheet.

Thanks for your help
Pierre

"Gary''s Student" wrote:

Hi Pierre62:

Getting symbols into VBA can be tedious. Lets use some cells to help us.
In Z1 thru Z4 we first enter:

™£
™¦
™¥
™*


and then an update to your poste code:

Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Integer, j As Integer, v As Variant, L As Integer


strToFind = Range("Z4").Value
lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
v = foundCell.Value
L = Len(v)
For i = 1 To L
startPos = InStr(i, v, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbBlue
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub


Should give you blue ™*

--
Gary''s Student - gsnu200840


"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once in
the cells? If so, then the following will fix it although you probably do not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are they
text characters from a font (if so, which one) or something else (if so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once
in
the cells? If so, then the following will fix it although you probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Pierre,

The code FormatAllSheetsText (below) will work on all sheets.

To get it to work, on Sheet1, in cells Z1:Z4, enter

club in Z1
diamond in Z2
heart in Z3
spade in Z4

And the code below that (FormatOneCellsText) can be used as you enter new
values, with the workbook's sheet change event:

Paste this code into the codemodule of the ThisWorkbook object:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
FormatOneCellsText Target
End Sub



HTH,
Bernie
MS Excel MVP

Sub FormatAllSheetsText()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Integer
Dim j As Integer
Dim v As Variant
Dim L As Integer
Dim myC As Range
Dim mySht As Worksheet
Dim myColors As Variant
Dim myColor As Variant


myColors = Array(50, 46, 3, 41)


For Each myC In Worksheets("Sheet1").Range("Z1:Z4")
strToFind = myC.Value
myColor = myColors(myC.Row - 1)
lngTofind = Len(strToFind)

For Each mySht In Worksheets
With mySht 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
v = foundCell.Value
L = Len(v)
For i = 1 To L
startPos = InStr(i, v, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.ColorIndex = myColor
'.Bold = True 'Other formatting if
required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
Next mySht
Next myC
End Sub

Sub FormatOneCellsText(myTarget As Range)
Dim strToFind As String
Dim lngTofind As Long
Dim startPos As Long
Dim myC As Range
Dim i As Integer
Dim j As Integer
Dim v As Variant
Dim L As Integer
Dim myColors As Variant
Dim myColor As Variant
' green clubs - club in Z1
' orange diamonds - in Z2
' red hearts - in Z3
' blue spades - in Z4

myColors = Array(50, 46, 3, 41)
For Each myC In Worksheets("Sheet1").Range("Z1:Z4")
strToFind = myC.Value
myColor = myColors(myC.Row - 1)
lngTofind = Len(strToFind)
With myTarget
v = .Value
L = Len(v)
For i = 1 To L
startPos = InStr(i, v, strToFind)
If startPos 0 Then
With .Characters(Start:=startPos, _
Length:=lngTofind).Font
.ColorIndex = myColor
'.Bold = True 'Other formatting if required
End With
End If
Next i
End With
Next myC
End Sub

"Pierre62" wrote in message
...
Hello Garrys'student.

I indeed get blue spades.
So the next step would be to get the other symbols also in the right
color.
And is it possible to make the script work for aal worksheets in my
workbook
with over 50 worksheet.

Thanks for your help
Pierre

"Gary''s Student" wrote:

Hi Pierre62:

Getting symbols into VBA can be tedious. Lets use some cells to help us.
In Z1 thru Z4 we first enter:

™£
™¦
™¥
™*


and then an update to your poste code:

Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Integer, j As Integer, v As Variant, L As Integer


strToFind = Range("Z4").Value
lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
v = foundCell.Value
L = Len(v)
For i = 1 To L
startPos = InStr(i, v, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbBlue
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub


Should give you blue ™*

--
Gary''s Student - gsnu200840


"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once in
the cells? If so, then the following will fix it although you probably
do not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Okay, here is a method to automatically color your symbols when you make the
entry into a cell. To implement this solution, right-click the XL symbol
immediately to the left of the File menu item and copy/paste the following
code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the ColorIndex
assignments from those that I used if you want to... I added some remark
comments in the various Case statements so you will know which symbol you
are dealing with.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are they
text characters from a font (if so, which one) or something else (if so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you probably
do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

By the way, if you did not want to do it the automatic way I outlined in my
previous posting, then here is the code re-worked into a macro that will
process all the text in all your worksheets at one time when you execute
it...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
Case Else
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the
ColorIndex assignments from those that I used if you want to... I added
some remark comments in the various Case statements so you will know which
symbol you are dealing with.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are
they
text characters from a font (if so, which one) or something else (if so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I
need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you probably
do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Just so you are aware... the code in both of my posting are completely stand
alone and do NOT require any helper cells in order to work.

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
By the way, if you did not want to do it the automatic way I outlined in
my previous posting, then here is the code re-worked into a macro that
will process all the text in all your worksheets at one time when you
execute it...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
Case Else
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the
ColorIndex assignments from those that I used if you want to... I added
some remark comments in the various Case statements so you will know
which symbol you are dealing with.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are
they
text characters from a font (if so, which one) or something else (if
so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I
need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you
probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

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

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

Stealing an idea from Keiji (sorry Keiji<g), this coding should be slightly
more efficient than what I posted earlier...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
End Select
If X 1 Then 'NT text
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the
ColorIndex assignments from those that I used if you want to... I added
some remark comments in the various Case statements so you will know which
symbol you are dealing with.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are
they
text characters from a font (if so, which one) or something else (if so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I
need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you probably
do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Stealing an idea from Keiji (sorry Keiji<g), this coding should be slightly
more efficient than what I posted earlier...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
By the way, if you did not want to do it the automatic way I outlined in
my previous posting, then here is the code re-worked into a macro that
will process all the text in all your worksheets at one time when you
execute it...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
Case Else
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the
ColorIndex assignments from those that I used if you want to... I added
some remark comments in the various Case statements so you will know
which symbol you are dealing with.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I use the Arial narrow font.

™£ = left Alt key + 5 of the numeric keypad
™¦ = left Alt key + 4 of the numeric keypad
™¥ = left Alt key + 3 of the numeric keypad
™* = left Alt key + 6 of the numeric keypad

I think this is in most fonts the same.

Thanks in advance for spending time to my problem.
Kind regards, Pierre

"Rick Rothstein" wrote:

How are you getting the ™£ ™¦ ™¥ ™* and NT "shapes" into your cells? Are
they
text characters from a font (if so, which one) or something else (if
so,
what)?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I
need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you
probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

Hello Rick, Keiji Gary's student and Bernie,

I don't know what went wrong but after saving may spreadsheet and reopening
it again the next day all my sheets were blank.
Fortunally I have a backup of a month ago so I did not loose toot much work.

I had to allow all macros. Is it possible to digitally sign the work you did
for me?

Grand Slam for you guys.
I am so happy.

Pierre

"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once in
the cells? If so, then the following will fix it although you probably do not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

I'm not sure what you mean by "digitally sign the work"... just copy/paste
them into your workbook where indicated and they are yours to use.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick, Keiji Gary's student and Bernie,

I don't know what went wrong but after saving may spreadsheet and
reopening
it again the next day all my sheets were blank.
Fortunally I have a backup of a month ago so I did not loose toot much
work.

I had to allow all macros. Is it possible to digitally sign the work you
did
for me?

Grand Slam for you guys.
I am so happy.

Pierre

"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once
in
the cells? If so, then the following will fix it although you probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

At the moment I have to accept all macros utherwise yours will not work.
I think this is not very safe.
There is an option to block all macros except the ones which are digitally
signed.
I made a certificate with selcert.exe but it still does not work.

Pierre



"Rick Rothstein" wrote:

I'm not sure what you mean by "digitally sign the work"... just copy/paste
them into your workbook where indicated and they are yours to use.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick, Keiji Gary's student and Bernie,

I don't know what went wrong but after saving may spreadsheet and
reopening
it again the next day all my sheets were blank.
Fortunally I have a backup of a month ago so I did not loose toot much
work.

I had to allow all macros. Is it possible to digitally sign the work you
did
for me?

Grand Slam for you guys.
I am so happy.

Pierre

"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I need.

Who can help me to change the code to work with the symbols I use in the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than once
in
the cells? If so, then the following will fix it although you probably do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

I've never worked with digital signatures, so I'm not sure what I can do to
help you out there. I think there is a way that you can digitally self-sign
your macros (which would mean you could copy/paste the code into your own
work and then digitally sign that). Perhaps someone familiar with the
process will come along and follow up on this for you. You could consider
lowering your security setting and visually analyze/examine any macros
before you implement them in your own workbooks (the setting you are
currently using would be most effective if you take in workbooks from other
sources and try to run them on your own system... I wouldn't think code you
create or implement should not require such a high setting. Also, trying
them out on a copy of your workbook so they can't accidentally affect any of
your original data is something you might also consider.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
At the moment I have to accept all macros utherwise yours will not work.
I think this is not very safe.
There is an option to block all macros except the ones which are digitally
signed.
I made a certificate with selcert.exe but it still does not work.

Pierre



"Rick Rothstein" wrote:

I'm not sure what you mean by "digitally sign the work"... just
copy/paste
them into your workbook where indicated and they are yours to use.

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick, Keiji Gary's student and Bernie,

I don't know what went wrong but after saving may spreadsheet and
reopening
it again the next day all my sheets were blank.
Fortunally I have a backup of a month ago so I did not loose toot much
work.

I had to allow all macros. Is it possible to digitally sign the work
you
did
for me?

Grand Slam for you guys.
I am so happy.

Pierre

"Pierre62" wrote:

Hello all, OssieMac,

I use excel to work out my conventions in the noble Bridge game.
Often I use things like 2™¦.
I like to change the colour of the ™¦ symbol into orange.
I do it by hand and it takes a lot of time.
I saw the question of Kay and the code of OssieMac is just what I
need.

Who can help me to change the code to work with the symbols I use in
the
colours I like?

™£ green
™¦ orange
™¥ red
™* blue
NT yellow


In advance, I thank you very much.
Pierre


Ossiemac gave the following code:

Do I interpret your comment to mean that " eg" can appear more than
once
in
the cells? If so, then the following will fix it although you probably
do
not
need it now if Gary's macro did the job.


Sub Format_Text()
Dim strToFind As String
Dim lngTofind As Long
Dim rngUsed As Range
Dim foundCell As Range
Dim startPos As Long
Dim firstAddress As String
Dim i As Long

strToFind = " eg" 'Set to required string

lngTofind = Len(strToFind)

With Sheets("Sheet1") 'Edit for your sheet name
Set rngUsed = .UsedRange
End With

With rngUsed
Set foundCell = .Find(What:=strToFind, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address

Do
For i = 1 To Len(foundCell)
startPos = InStr(i, foundCell, strToFind)
If startPos 0 Then
With foundCell.Characters(Start:=startPos, _
Length:=lngTofind).Font
.Color = vbRed
'.Bold = True 'Other formatting if required
End With
End If
Next i
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And _
foundCell.Address < firstAddress
End If
End With
End Sub

For Pierre

Set your macro security settings to "Disable with notification" and you will
get the option to enable or disable macros when you open the workbook.

If you don't want to deal with the warning you can sign the workbook with
the selefcert DS you created.

If you have already created a selfcert DS you will find it the Management
Console under Personal Signatures after loading the Signatures Snap-in.

Steps............after closing Excel

StartRun mmc

Load the MMC digital signature snap-in from FileAdd/Remove Snap-in

Select Certificates and Certificates-Current User

Open Personal folder.

You must copy the selfcert DS from Personal Signatures to Trusted Publishers

Then...............................

With your workbook open and in VBE, select ToolsDigital SignaturesChoose

Your selfcert DS will be available for signing that workbook.


Gord Dibben MS Excel MVP


On Sun, 22 Mar 2009 16:06:53 -0400, "Rick Rothstein"
wrote:

I've never worked with digital signatures, so I'm not sure what I can do to
help you out there. I think there is a way that you can digitally self-sign
your macros (which would mean you could copy/paste the code into your own
work and then digitally sign that). Perhaps someone familiar with the
process will come along and follow up on this for you. You could consider
lowering your security setting and visually analyze/examine any macros
before you implement them in your own workbooks (the setting you are
currently using would be most effective if you take in workbooks from other
sources and try to run them on your own system... I wouldn't think code you
create or implement should not require such a high setting. Also, trying
them out on a copy of your workbook so they can't accidentally affect any of
your original data is something you might also consider.

After choosing your certificate you must save the file.


Gord

On Sun, 22 Mar 2009 13:55:02 -0700, Gord Dibben <gorddibbATshawDOTca wrote:

For Pierre

Set your macro security settings to "Disable with notification" and you will
get the option to enable or disable macros when you open the workbook.

If you don't want to deal with the warning you can sign the workbook with
the selefcert DS you created.

If you have already created a selfcert DS you will find it the Management
Console under Personal Signatures after loading the Signatures Snap-in.

Steps............after closing Excel

StartRun mmc

Load the MMC digital signature snap-in from FileAdd/Remove Snap-in

Select Certificates and Certificates-Current User

Open Personal folder.

You must copy the selfcert DS from Personal Signatures to Trusted Publishers

Then...............................

With your workbook open and in VBE, select ToolsDigital SignaturesChoose

Your selfcert DS will be available for signing that workbook.


Gord Dibben MS Excel MVP


On Sun, 22 Mar 2009 16:06:53 -0400, "Rick Rothstein"
wrote:

I've never worked with digital signatures, so I'm not sure what I can do to
help you out there. I think there is a way that you can digitally self-sign
your macros (which would mean you could copy/paste the code into your own
work and then digitally sign that). Perhaps someone familiar with the
process will come along and follow up on this for you. You could consider
lowering your security setting and visually analyze/examine any macros
before you implement them in your own workbooks (the setting you are
currently using would be most effective if you take in workbooks from other
sources and try to run them on your own system... I wouldn't think code you
create or implement should not require such a high setting. Also, trying
them out on a copy of your workbook so they can't accidentally affect any of
your original data is something you might also consider.

Hi Rick

Thank you for your nice comments. I know no need of EnableEvents in this
case, but i put it for the future's change though it would not happen. I
like your style of moving i=i+1 out of if block and it has made my code
very simple. Changing the color at first place contributes to the
speeding up the time of process in my test. Anyway, thanks again.

Keiji

Rick Rothstein wrote:
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.

Hello guys,

I encountered two minor problems.

1 When I trie to undo something (Ctrl+z), that does not work.
2 When using the macro, all text turns to black, also the one I gave
another color.

Is it hard to change this?

Kind regards,
Pierre

1 When I trie to undo something (Ctrl+z), that does not work.

This is a problem with all VB code... it tends to clear out the clipboard.

2 When using the macro, all text turns to black, also the one
I gave another color.

This will fix my macro so it won't do that...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello guys,

I encountered two minor problems.

1 When I trie to undo something (Ctrl+z), that does not work.
2 When using the macro, all text turns to black, also the one I gave
another color.

Is it hard to change this?

Kind regards,
Pierre

Hello Rick,

you're great.
Thanks for your efforts.

Kind regards.
Pierre



"Rick Rothstein" wrote:

1 When I trie to undo something (Ctrl+z), that does not work.

This is a problem with all VB code... it tends to clear out the clipboard.

2 When using the macro, all text turns to black, also the one
I gave another color.

This will fix my macro so it won't do that...

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 46
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
Next
End Sub

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello guys,

I encountered two minor problems.

1 When I trie to undo something (Ctrl+z), that does not work.
2 When using the macro, all text turns to black, also the one I gave
another color.

Is it hard to change this?

Kind regards,
Pierre

Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

I don't think so. The macro visited each cell in each worksheet and (at
first) changed all text to black (actually, Automatic) before applying the
colors to those characters needing the change. The event code (what you are
calling "the non-macro") only applies the color to the symbols in the actual
cell being edited. Now, I might have to change the code for you IF you ever
have a mixture of existing, pre-colored non-symbol text together with your
symbols and you choose to edit only part of that text. The reason I would
have to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic) before
applying the symbol coloring... so if you had existing colored non-symbol
text in the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols, or
something else.
Is it possible to limit the size of a worksheet to let's say 100 columns and
500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

"Rick Rothstein" wrote:

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

I don't think so. The macro visited each cell in each worksheet and (at
first) changed all text to black (actually, Automatic) before applying the
colors to those characters needing the change. The event code (what you are
calling "the non-macro") only applies the color to the symbols in the actual
cell being edited. Now, I might have to change the code for you IF you ever
have a mixture of existing, pre-colored non-symbol text together with your
symbols and you choose to edit only part of that text. The reason I would
have to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic) before
applying the symbol coloring... so if you had existing colored non-symbol
text in the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Inserting a new row invokes SheetChange event, so it takes some time to
loop all cells in Target range. But it's strange for me this would take
so long time as you said. Besides in my thought, It seems the line "For
Each R In Target" is useless in your case and the code
"Application.EnableEvents = False" will stop to go into this series of
SheetChange event.

Keiji

Pierre62 wrote:
Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols, or
something else.
Is it possible to limit the size of a worksheet to let's say 100 columns and
500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

"Rick Rothstein" wrote:

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?
I don't think so. The macro visited each cell in each worksheet and (at
first) changed all text to black (actually, Automatic) before applying the
colors to those characters needing the change. The event code (what you are
calling "the non-macro") only applies the color to the symbols in the actual
cell being edited. Now, I might have to change the code for you IF you ever
have a mixture of existing, pre-colored non-symbol text together with your
symbols and you choose to edit only part of that text. The reason I would
have to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic) before
applying the symbol coloring... so if you had existing colored non-symbol
text in the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Ignore my comment about "Application.EnableEvents = False". In this case
this doesn't have nothing with slowness. Sorry about misinformation.

keiji

keiji kounoike wrote:
Inserting a new row invokes SheetChange event, so it takes some time to
loop all cells in Target range. But it's strange for me this would take
so long time as you said. Besides in my thought, It seems the line "For
Each R In Target" is useless in your case and the code
"Application.EnableEvents = False" will stop to go into this series of
SheetChange event.

Keiji

Pierre62 wrote:
Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols, or
something else.
Is it possible to limit the size of a worksheet to let's say 100
columns and 500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

"Rick Rothstein" wrote:

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want
to change
something in the other one, the non-macro?
I don't think so. The macro visited each cell in each worksheet and
(at first) changed all text to black (actually, Automatic) before
applying the colors to those characters needing the change. The event
code (what you are calling "the non-macro") only applies the color to
the symbols in the actual cell being edited. Now, I might have to
change the code for you IF you ever have a mixture of existing,
pre-colored non-symbol text together with your symbols and you choose
to edit only part of that text. The reason I would have to change the
code in that circumstance is because the event code changes all the
existing text in the cell to black (Automatic) before applying the
symbol coloring... so if you had existing colored non-symbol text in
the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want
to change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Hello all,

I found out that a workbook with only 2 smaal sheets in it has a size of
over 11 MB.
I selected alla sheets and then all cells and changed the color of the font.
Then I saved it again.
Now the file is only 29 Kb and all is running normal.

I suppose some macro at a certain moment formatted aal cells in all sheets
with some information....

If you want the sheet for research, let me know, I will send it to you by
email.

Kind regards,
Pierre

"Pierre62" wrote:

Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols, or
something else.
Is it possible to limit the size of a worksheet to let's say 100 columns and
500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

"Rick Rothstein" wrote:

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

I don't think so. The macro visited each cell in each worksheet and (at
first) changed all text to black (actually, Automatic) before applying the
colors to those characters needing the change. The event code (what you are
calling "the non-macro") only applies the color to the symbols in the actual
cell being edited. Now, I might have to change the code for you IF you ever
have a mixture of existing, pre-colored non-symbol text together with your
symbols and you choose to edit only part of that text. The reason I would
have to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic) before
applying the symbol coloring... so if you had existing colored non-symbol
text in the cell, it would be made black (Automatic) and only the symbols
would be colored. Do you, or would you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want to
change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and over.
When I hit the Esc key I select the "debug/error" button (I work with a duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

Pierre,

You could check for the number of cells first:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range

If Target.Cells.Count 1 Then Exit Sub

If you never use Ctrl-Enter to change multiple cells at once, then leaving
the comparison at 1 is OK.

HTH,
Bernie
MS Excel MVP


"Pierre62" wrote in message
...
Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and
over.
When I hit the Esc key I select the "debug/error" button (I work with a
duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

See if this event procedure code works better for you...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
On Error Resume Next
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and
over.
When I hit the Esc key I select the "debug/error" button (I work with a
duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

Rick Rothstein wrote:
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one
symbol within your text string if you want or need to)... when you hit
the Enter Key, those symbols will change color. Oh, and you can change
the ColorIndex assignments from those that I used if you want to... I
added some remark comments in the various Case statements so you will
know which symbol you are dealing with.

You didn't include a message with your posting.

--
Rick (MVP - Excel)


"keiji kounoike" <"kounoike AT mbh.nifty.com" wrote in message
...


Rick Rothstein wrote:
Okay, here is a method to automatically color your symbols when you make
the entry into a cell. To implement this solution, right-click the XL
symbol immediately to the left of the File menu item and copy/paste the
following code into the code window that appears...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

Now, go back any worksheet and type some text that contains your card
symbols and/or No Trump symbol (note... you can have more than one symbol
within your text string if you want or need to)... when you hit the Enter
Key, those symbols will change color. Oh, and you can change the
ColorIndex assignments from those that I used if you want to... I added
some remark comments in the various Case statements so you will know
which symbol you are dealing with.

Hello Bernie,

this works good for me.
A big plus is that the undo (Ctrl+Z) function works again when I select more
than one cell.

Thanks a lot.

Kind regards from Pierre

"Bernie Deitrick" wrote:

Pierre,

You could check for the number of cells first:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range

If Target.Cells.Count 1 Then Exit Sub

If you never use Ctrl-Enter to change multiple cells at once, then leaving
the comparison at 1 is OK.

HTH,
Bernie
MS Excel MVP


"Pierre62" wrote in message
...
Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and
over.
When I hit the Esc key I select the "debug/error" button (I work with a
duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

Hello Rick,

that did not help me.
I did what Bernie suggested and that works.

Thanks for all your efforts.

Kind regards,
Pierre

"Rick Rothstein" wrote:

See if this event procedure code works better for you...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
On Error Resume Next
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and
over.
When I hit the Esc key I select the "debug/error" button (I work with a
duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

Ok, I'll do that

keiji kounoike wrote:
Ignore my comment about "Application.EnableEvents = False". In this case
this doesn't have nothing with slowness. Sorry about misinformation.

keiji

keiji kounoike wrote:
Inserting a new row invokes SheetChange event, so it takes some time
to loop all cells in Target range. But it's strange for me this would
take so long time as you said. Besides in my thought, It seems the
line "For Each R In Target" is useless in your case and the code
"Application.EnableEvents = False" will stop to go into this series of
SheetChange event.

Keiji

Pierre62 wrote:
Hello Rick,

I understand what you mean but I don't think I need it.

But I have another problem.
When i.e. inserting a new row, it takes a lot of time before it happens.
It seems the macro is working the whole sheet updating the symbols,
or something else.
Is it possible to limit the size of a worksheet to let's say 100
columns and 500 rows?


I am starting to feel guilty asking things everytime....

Kind regards from Pierre

"Rick Rothstein" wrote:

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want
to change
something in the other one, the non-macro?
I don't think so. The macro visited each cell in each worksheet and
(at first) changed all text to black (actually, Automatic) before
applying the colors to those characters needing the change. The
event code (what you are calling "the non-macro") only applies the
color to the symbols in the actual cell being edited. Now, I might
have to change the code for you IF you ever have a mixture of
existing, pre-colored non-symbol text together with your symbols and
you choose to edit only part of that text. The reason I would have
to change the code in that circumstance is because the event code
changes all the existing text in the cell to black (Automatic)
before applying the symbol coloring... so if you had existing
colored non-symbol text in the cell, it would be made black
(Automatic) and only the symbols would be colored. Do you, or would
you ever, have such a situation?

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

one more question....

I use your latest macro from 23-03-2009.
Changing this macro to what it is now, does it mean you might want
to change
something in the other one, the non-macro?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target
As Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

As you can see I changed the colors and NT is SA.


Kind regards,
Pierre

Sorry, I pushed Send button to the wrong article by mistake.
But I can't see any diffrence between your code posted at Sat, 21 Mar
2009 14:52:43 with
and posted at Wed, 25 Mar 2009 16:36:19 with
except that the later
one has "On Error Resume Next" code in it. And i just can't get it what
this code do for.

Keiji

Rick Rothstein wrote:
You didn't include a message with your posting.

Op woensdag 25 maart 2009 21:36:19 UTC+1 schreef Rick Rothstein:
See if this event procedure code works better for you...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
On Error Resume Next
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 5
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 46
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X 1 Then
If Mid(R.Value, X - 1, 2) = "NT" Then
R.Characters(X - 1, 2).Font.ColorIndex = 44
End If
End If
Next
Next
End Sub

--
Rick (MVP - Excel)


"Pierre62" wrote in message
...
Hello Rick,

I still have problems with the code you gave me.
Not the macro but the other one.
I made a new workbook with one worksheet.
I have put the non-macro in the ThisWorkbook sheet.
I deleted several comluns at one time and then Excel is working over and
over.
When I hit the Esc key I select the "debug/error" button (I work with a
duch
version) this line is colored yellow:

For X = 1 To Len(R.Value)

so I suppose there is the reason why it takes so long.
I hope you have the same and will be able to fix it.
If you don't have it, do you have any idea what the problem could be?

Pierre

This is the code I use:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim X As Long
Dim R As Range
For Each R In Target
R.Characters.Font.ColorIndex = xlColorIndexAutomatic
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X 1 Then 'SA text
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

Hello all,

I worked for years with this code and I am still very happy with it, but now I have a new partner and he does not use Excel but Word.
I tried to use this code in Word, but as there are no cells in Word, it did not work (probably more reasons...).

Is there anyone who can change it in order to work in Word (2010 / 2013) please?

In advance, thank you very much.
Pierre