Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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. |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
When I ran your amended version, only the last HL was changed to a checkmark.
The x-1 occurrences in the same cell were P's. I think it was each time you repopulated the value, the font reverted to the font of the first character. the original: asdfHLqwerHL became: asdfPqwer(cm) (cm) = check mark. Bob Phillips wrote: 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. -- Dave Peterson |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cherecters and fonts in part of cell
Cheeeeeeeeeeeears Dave.
This modification works like a charm...... Many many thanks Dave. I was struggling from last 15 days to acheive this but failed in the last stage. Bob, Thanks to you also. Actually that time the code was changing any cherecter irrespective to its position. The reason I said vague is coz I could not establish any pattern or logic for wrong replacements. Thanks again to spend your time for solving my puzzle. I WITH BOTH OF YOU AND THE NG LISTERS A VERY VERY HAPPY AND PROSPOROUS NEW YEAR. WITH A HOPE THAT TSUNAMI DOES NOT COME AGAIN. Regards, Shetty. Dave Peterson wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to mix fonts in a cell? | Excel Discussion (Misc queries) | |||
Search/Match/Find ANY part of string to ANY part of Cell Value | Excel Worksheet Functions | |||
Is it possible to use 2 different fonts in 1 excel cell? | Excel Discussion (Misc queries) | |||
How can I lengthen the drop down Fonts list to show more fonts at | Excel Discussion (Misc queries) | |||
2 different fonts in a cell | Excel Discussion (Misc queries) |