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
|