View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default Cherecters and fonts in part of cell

Shetty,

How about this

Sub JI()
Dim pos As Long
Dim CELL As Range

For Each CELL In Selection
pos = InStr(1, CELL.Value, "HL")
If pos 0 Then
CELL.Value = Left(CELL.Value, pos - 1) & "P" & Right(CELL.Value,
Len(CELL.Value) - pos - 1)
CELL.Characters(pos, 1).Font.Name = "Wingdings 2"
End If
Next CELL
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Shetty" wrote in message
oups.com...
Hi all,
I have a peculer problem.
I need to search each selected cell for cherecters HL and replace it
with P. It is case sensitive.
All the cherecters in the cell have font as aerial, I want font as
WINGDINGS 2 only for the replaced cherecter. THE CATCH IS THAT FOR ALL
OCCURANCES OF HL IN AERIAL I WANT P IN WINGDING 2 FONT LEAVING REST OF
THE CHERECTERS WITH AERIAL FONT.

I tried the following code which replaces all the occurances but it
changes font only for the 1st occurance. There may be multiple
occurances in a single cell.
Can somebody tell me whats wrong with this code?
Regards,
Shetty.

My code so far:
Sub JI()
Dim PP
Dim CELL As Range

For Each CELL In Selection
CELL.Activate
PP = InStr(1, ActiveCell, "HL", vbTextCompare)

ActiveCell.Replace What:="HL", Replacement:="P", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False,
ReplaceFormat:=False
ActiveCell.Characters(Start:=PP, Length:=1).Font.NAME = "wingdings 2"
ActiveCell.Characters(Start:=PP, Length:=1).Font.Bold = True
Next

End Sub