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

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

Bob,
Thanks for reply.
But it replaces only the 1st occurance. 2nd occurance is not replaced.
I need to replace all the occurances of HL with P and font of replaced
P
needs to be wingding 2.
Any more thoughts?

Thanks,
Shetty.

Do you mean multiple occurrences in a cell?

If so, then

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

For Each CELL In Selection
Do
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
Loop Until pos = 0
Next CELL
End Sub

--

HTH

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


"Shetty" wrote in message
ups.com...
Bob,
Thanks for reply.
But it replaces only the 1st occurance. 2nd occurance is not replaced.
I need to replace all the occurances of HL with P and font of replaced
P
needs to be wingding 2.
Any more thoughts?

Thanks,
Shetty.

This modification of Bob's routine worked ok for me:

Option Explicit
Sub JI2()
Dim pos As Long
Dim CELL As Range
Dim myPositions() As Long
Dim pCtr As Long

For Each CELL In Selection
pCtr = 0
Do
pos = InStr(1, CELL.Value, "HL", vbBinaryCompare)
If pos = 0 Then
Exit Do
End If

pCtr = pCtr + 1
ReDim Preserve myPositions(1 To pCtr)
myPositions(pCtr) = pos
CELL.Value = Left(CELL.Value, pos - 1) & "P" _
& Right(CELL.Value, Len(CELL.Value) - pos - 1)
Loop

For pCtr = LBound(myPositions) To UBound(myPositions)
CELL.Characters(myPositions(pCtr), 1).Font.Name = "Wingdings 2"
Next pCtr
Next CELL

End Sub



Shetty wrote:

Bob,
Thanks for reply.
But it replaces only the 1st occurance. 2nd occurance is not replaced.
I need to replace all the occurances of HL with P and font of replaced
P
needs to be wingding 2.
Any more thoughts?

Thanks,
Shetty.

--

Dave Peterson

Thanks to both of you.
Yes Bob. There may be multiple occurances as well as nil occurances. I
tried your code with do loop but it does not work, gives very vague
results. I don't know why it works that way with do loop.

Dave - I have added one If Not IsEmpty(CELL) Then statement to skip
blank cells.
Your code works fine as long as there is atleast one occurance.
If the cell does not contain HL then 1st part to replace is skipped by
If pos = 0 Then
Exit Do
End If
But, 2nd part is still executed. Its a for loop.
For pCtr = LBound(myPositions) To UBound(myPositions)
CELL.Characters(myPositions(pCtr), 1).Font.NAME = "wingding 2"
CELL.Characters(myPositions(pCtr), 1).Font.Bold = True
Next pCtr

There are two things.
1. If 1st cell is with nil occurance, then code breaks on error
highlighting above for loop (subscript out of range).
2. If If any subsequent cell is with nil occurance, then above for loop
changes the font of any other cherecter making it unreadable.

I tried to bypass this for loop with a goto statement.
If pos =0 then goto ncell
....code
ncell:
next cell
end sub
With this, cells with nil occurance are not changed but the replacement
made in cells containing HL are not applied new font.

I hope, this also can be solved or a workaround is possible.
Regards,
Shetty.

It worked fine for me, cells with none, 1 and 2.

What does vague results mean?

--

HTH

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


"Shetty" wrote in message
ups.com...
Thanks to both of you.
Yes Bob. There may be multiple occurances as well as nil occurances. I
tried your code with do loop but it does not work, gives very vague
results. I don't know why it works that way with do loop.

Dave - I have added one If Not IsEmpty(CELL) Then statement to skip
blank cells.
Your code works fine as long as there is atleast one occurance.
If the cell does not contain HL then 1st part to replace is skipped by
If pos = 0 Then
Exit Do
End If
But, 2nd part is still executed. Its a for loop.
For pCtr = LBound(myPositions) To UBound(myPositions)
CELL.Characters(myPositions(pCtr), 1).Font.NAME = "wingding 2"
CELL.Characters(myPositions(pCtr), 1).Font.Bold = True
Next pCtr

There are two things.
1. If 1st cell is with nil occurance, then code breaks on error
highlighting above for loop (subscript out of range).
2. If If any subsequent cell is with nil occurance, then above for loop
changes the font of any other cherecter making it unreadable.

I tried to bypass this for loop with a goto statement.
If pos =0 then goto ncell
...code
ncell:
next cell
end sub
With this, cells with nil occurance are not changed but the replacement
made in cells containing HL are not applied new font.

I hope, this also can be solved or a workaround is possible.
Regards,
Shetty.

This modification of my modification of Bob's original code seemed to work ok:

Option Explicit
Sub JI2()
Dim pos As Long
Dim CELL As Range
Dim myPositions() As Long
Dim pCtr As Long
Dim FoundOne As Boolean

For Each CELL In Selection
FoundOne = False
pCtr = 0
Do
pos = InStr(1, CELL.Value, "HL", vbBinaryCompare)
If pos = 0 Then
Exit Do
End If
FoundOne = True

pCtr = pCtr + 1
ReDim Preserve myPositions(1 To pCtr)
myPositions(pCtr) = pos
CELL.Value = Left(CELL.Value, pos - 1) & "P" _
& Right(CELL.Value, Len(CELL.Value) - pos - 1)
Loop

If FoundOne = True Then
For pCtr = LBound(myPositions) To UBound(myPositions)
CELL.Characters(myPositions(pCtr), 1).Font.Name = "Wingdings 2"
Next pCtr
End If
Next CELL

End Sub

Shetty wrote:

Thanks to both of you.
Yes Bob. There may be multiple occurances as well as nil occurances. I
tried your code with do loop but it does not work, gives very vague
results. I don't know why it works that way with do loop.

Dave - I have added one If Not IsEmpty(CELL) Then statement to skip
blank cells.
Your code works fine as long as there is atleast one occurance.
If the cell does not contain HL then 1st part to replace is skipped by
If pos = 0 Then
Exit Do
End If
But, 2nd part is still executed. Its a for loop.
For pCtr = LBound(myPositions) To UBound(myPositions)
CELL.Characters(myPositions(pCtr), 1).Font.NAME = "wingding 2"
CELL.Characters(myPositions(pCtr), 1).Font.Bold = True
Next pCtr

There are two things.
1. If 1st cell is with nil occurance, then code breaks on error
highlighting above for loop (subscript out of range).
2. If If any subsequent cell is with nil occurance, then above for loop
changes the font of any other cherecter making it unreadable.

I tried to bypass this for loop with a goto statement.
If pos =0 then goto ncell
...code
ncell:
next cell
end sub
With this, cells with nil occurance are not changed but the replacement
made in cells containing HL are not applied new font.

I hope, this also can be solved or a workaround is possible.
Regards,
Shetty.

--

Dave Peterson