Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA to superscript a part of a cell
On Thu, 15 Apr 2010 10:24:05 -0700 (PDT), Mikhail Bogorad
wrote: hi i have a report that populates some text descriptions in cells range B2:B15. So sometimes text has a date, for example "... October 1st...". What i want is to superscript letters "st" every time it finds "1st". Has anyone ever encountered this problem before? Thanks There are some issues you haven't mentioned. 1. Are the cell contents strings, or are they the results of formulas. If they are the results of formulas, then they must be converted to strings in order to superscript a few letters. 2. Could there be more than one substring that requires superscripting. For example, May 21st through May 28th ? 3. How do you want to handle a number followed by two letters that do not represent a valid ordinal suffix? For example: 101th day of the year. Here is a routine that If the contents of the cell "qualify" by containing an ordinal number, then the contents will be converted to a text string in order to apply the ordinal superscripting. If the ordinal value is not valid, nothing will be done. It can handle any number of ordinal values within the string. ================================================== ========= Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim N As Long Dim SuffixStart As Long Dim c As Range For Each c In Range("B2:B15") Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc N = m.SubMatches(0) Select Case N Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case N Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(N)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub =================================== --ron |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA to superscript a part of a cell
On Thu, 15 Apr 2010 21:07:16 -0400, Ron Rosenfeld
wrote: On Thu, 15 Apr 2010 10:24:05 -0700 (PDT), Mikhail Bogorad wrote: hi i have a report that populates some text descriptions in cells range B2:B15. So sometimes text has a date, for example "... October 1st...". What i want is to superscript letters "st" every time it finds "1st". Has anyone ever encountered this problem before? Thanks There are some issues you haven't mentioned. 1. Are the cell contents strings, or are they the results of formulas. If they are the results of formulas, then they must be converted to strings in order to superscript a few letters. 2. Could there be more than one substring that requires superscripting. For example, May 21st through May 28th ? 3. How do you want to handle a number followed by two letters that do not represent a valid ordinal suffix? For example: 101th day of the year. Here is a routine that If the contents of the cell "qualify" by containing an ordinal number, then the contents will be converted to a text string in order to apply the ordinal superscripting. If the ordinal value is not valid, nothing will be done. It can handle any number of ordinal values within the string. ================================================= ========== Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim N As Long Dim SuffixStart As Long Dim c As Range For Each c In Range("B2:B15") Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc N = m.SubMatches(0) Select Case N Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case N Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(N)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub =================================== --ron Oops. A change. If you want to convert qualifying contents produced by a formula into a text string, you need to do it this way: If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings --- If c.HasFormula = True Then c.Value = c.Text <--- SuffixStart = m.FirstIndex + 1 + Len(CStr(n)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Otherwise, only the last ordinal gets superscripted as things get overwritten each time through. So the entire routine: ============================== Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim n As Long Dim SuffixStart As Long Dim c As Range For Each c In Selection Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc n = m.SubMatches(0) Select Case n Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case n Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings If c.HasFormula = True Then c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(n)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub ==================================== --ron |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA to superscript a part of a cell
"Ron Rosenfeld" wrote in message ... On Thu, 15 Apr 2010 21:07:16 -0400, Ron Rosenfeld wrote: On Thu, 15 Apr 2010 10:24:05 -0700 (PDT), Mikhail Bogorad wrote: hi i have a report that populates some text descriptions in cells range B2:B15. So sometimes text has a date, for example "... October 1st...". What i want is to superscript letters "st" every time it finds "1st". Has anyone ever encountered this problem before? Thanks There are some issues you haven't mentioned. 1. Are the cell contents strings, or are they the results of formulas. If they are the results of formulas, then they must be converted to strings in order to superscript a few letters. 2. Could there be more than one substring that requires superscripting. For example, May 21st through May 28th ? 3. How do you want to handle a number followed by two letters that do not represent a valid ordinal suffix? For example: 101th day of the year. Here is a routine that If the contents of the cell "qualify" by containing an ordinal number, then the contents will be converted to a text string in order to apply the ordinal superscripting. If the ordinal value is not valid, nothing will be done. It can handle any number of ordinal values within the string. ================================================ =========== Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim N As Long Dim SuffixStart As Long Dim c As Range For Each c In Range("B2:B15") Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc N = m.SubMatches(0) Select Case N Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case N Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(N)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub =================================== --ron Oops. A change. If you want to convert qualifying contents produced by a formula into a text string, you need to do it this way: If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings --- If c.HasFormula = True Then c.Value = c.Text <--- SuffixStart = m.FirstIndex + 1 + Len(CStr(n)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Otherwise, only the last ordinal gets superscripted as things get overwritten each time through. So the entire routine: ============================== Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim n As Long Dim SuffixStart As Long Dim c As Range For Each c In Selection Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc n = m.SubMatches(0) Select Case n Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case n Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings If c.HasFormula = True Then c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(n)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub ==================================== --ron Couple of thoughts Why not place these lines before the loop, particularly the first one to avoid creating the object each time Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True Not sure it's right to convert a formula to a value, at least not unless specifically required to do so (I know you drew attention to it in the comments). Regards, Peter T |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA to superscript a part of a cell
On Fri, 16 Apr 2010 11:37:21 +0100, "Peter T" <peter_t@discussions wrote:
Couple of thoughts Why not place these lines before the loop, particularly the first one to avoid creating the object each time Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True Thanks for noticing that. When I first wrote the routine, it was for just a single cell. And when I added the loop, having those lines inside was a definite oversight. Not sure it's right to convert a formula to a value, at least not unless specifically required to do so (I know you drew attention to it in the comments). Yes, that's why I made it optional and added the comment in the text. It occurred to me that, depending on how the OP "Populated" the range, it might be done with formulas, as opposed to a Copy/Paste Values operation, and that he should be aware that the superscripting cannot be easily done on other than text strings (unless one had a superscripted font character that could be used in a custom format). Anyway, here's the routine with the object creation moved outside the loop, as it should have been done the first time: =============================== Option Explicit Sub SupScriptOrdinal() Dim re As Object, mc As Object, m As Object Dim Suffix As String Dim n As Long Dim SuffixStart As Long Dim c As Range Set re = CreateObject("vbscript.regexp") re.Pattern = "\b(\d+)(\w{2})\b" re.Global = True For Each c In Selection 'or in Range("B2:B15") If re.test(c) = True Then Set mc = re.Execute(c) For Each m In mc n = m.SubMatches(0) Select Case n Mod 10 Case Is = 1 Suffix = "st" Case Is = 2 Suffix = "nd" Case Is = 3 Suffix = "rd" Case Else Suffix = "th" End Select Select Case n Mod 100 Case 11 To 19 Suffix = "th" End Select If Suffix = LCase(m.SubMatches(1)) Then 'comment next line if you do not want to convert ' qualifying contents to text strings If c.HasFormula = True Then c.Value = c.Text SuffixStart = m.FirstIndex + 1 + Len(CStr(n)) c.Characters(SuffixStart, 2).Font.Superscript = True End If Next m End If Next c End Sub ======================================= --ron |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VBA to superscript a part of a cell | Excel Programming | |||
VBA to superscript a part of a cell | Excel Programming | |||
VBA to superscript a part of a cell | Excel Programming | |||
how do i superscript part of a cell in MS Excel? | Excel Discussion (Misc queries) | |||
how do i superscript part of a cell in MS Excel? | Excel Discussion (Misc queries) |