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