VBA to superscript a part of a cell

Discussion in 'Microsoft Excel Programming' started by Mikhail Bogorad, Apr 15, 2010.

  1. 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
     
    Mikhail Bogorad, Apr 15, 2010
    #1
    1. Advertisements

  2. Mikhail Bogorad

    JLGWhiz Guest

    This is a sample of the syntax to accomplish the goal. Without knowing how
    the data appears within your file, I cannot offer any more than this.

    Range("B3").Characters(7, 2).Font.Superscript = True

    This would re-format the seventh and eighth characters in the cell to
    superscript. I am not sure how to find the occurrences in the file by
    random search. Maybe somebody smarter than me will assist.



    "Mikhail Bogorad" <> wrote in message
    news:...
    > 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
     
    JLGWhiz, Apr 15, 2010
    #2
    1. Advertisements

  3. Mikhail Bogorad

    Peter T Guest

    Try this in a normal module

    Option Explicit
    Sub Test()
    Dim rng As Range
    Dim cel As Range

    On Error Resume Next
    Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    On Error GoTo 0
    If Not rng Is Nothing Then
    For Each cel In rng
    SuperNum cel
    Next
    End If
    End Sub

    Sub SuperNum(rCell As Range)
    Dim n As Long, pos As Long
    Dim s As String
    Dim Target As Range
    Dim vData, v, vFlag
    Dim arr()

    arr = Array("th", "st", "rd")
    Set Target = Selection
    If rCell.HasFormula = False Then
    vData = rCell.Value
    If VarType(vData) = vbString Then
    vFlag = rCell.Font.Superscript

    If IsNull(vFlag) Then vFlag = True
    If vFlag Then rCell.Font.Superscript = False
    s = rCell.Value
    If Len(s) > 2 Then
    For Each v In arr
    pos = 0
    pos = InStr(2, s, v)
    If pos Then
    n = Val(Mid$(s, pos - 1, 1))
    If n Then
    If pos + 1 < Len(s) Then
    If Mid$(s, pos + 2, 1) <> " " Then n = 0
    End If
    End If
    If n > 0 Then
    rCell.Characters(pos, 2).Font.Superscript = True
    Exit For
    End If
    End If
    Next
    End If
    End If
    End If
    End Sub

    Run Test() to process the active sheet

    If you want changes to update immediately, try this in a worksheet module
    (right - click sheet tab, view code)

    Private Sub Worksheet_Change(ByVal Target As Range)
    SuperNum Target(1)
    End Sub

    Regards,
    Peter T




    "Mikhail Bogorad" <> wrote in message
    news:...
    > 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
     
    Peter T, Apr 15, 2010
    #3
  4. If I can anticipate your complete requirements (for 1st, 2nd, 3rd, nth),
    give this macro a try after the cells have been filled in with their text...

    Sub SuperScriptOrdinals()
    Dim X As Long, NumPosition As Long, Cell As Range
    For Each Cell In Range("B2:B15")
    NumPosition = InStr(Cell.Value, "1st")
    If NumPosition = 0 Then
    NumPosition = InStr(Cell.Value, "2nd")
    If NumPosition = 0 Then
    NumPosition = InStr(Cell.Value, "3rd")
    If NumPosition = 0 Then
    For NumPosition = 1 To Len(Cell.Text)
    If Mid(Cell.Value, NumPosition) Like "#th*" Then Exit For
    Next
    End If
    End If
    End If
    If NumPosition Then
    Cell.Characters(NumPosition + 1, 2).Font.Superscript = True
    End If
    Next
    End Sub

    --
    Rick (MVP - Excel)



    "Mikhail Bogorad" <> wrote in message
    news:...
    > 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
     
    Rick Rothstein, Apr 15, 2010
    #4
  5. Mikhail Bogorad

    Gord Dibben Guest

    Very nice Peter.

    I have saved this one.

    You could add "nd" to the array.


    Gord

    On Thu, 15 Apr 2010 19:43:14 +0100, "Peter T" <peter_t@discussions> wrote:

    >Try this in a normal module
    >
    >Option Explicit
    >Sub Test()
    >Dim rng As Range
    >Dim cel As Range
    >
    > On Error Resume Next
    > Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    > On Error GoTo 0
    > If Not rng Is Nothing Then
    > For Each cel In rng
    > SuperNum cel
    > Next
    > End If
    >End Sub
    >
    >Sub SuperNum(rCell As Range)
    >Dim n As Long, pos As Long
    >Dim s As String
    >Dim Target As Range
    >Dim vData, v, vFlag
    >Dim arr()
    >
    > arr = Array("th", "st", "rd")
    > Set Target = Selection
    > If rCell.HasFormula = False Then
    > vData = rCell.Value
    > If VarType(vData) = vbString Then
    > vFlag = rCell.Font.Superscript
    >
    > If IsNull(vFlag) Then vFlag = True
    > If vFlag Then rCell.Font.Superscript = False
    > s = rCell.Value
    > If Len(s) > 2 Then
    > For Each v In arr
    > pos = 0
    > pos = InStr(2, s, v)
    > If pos Then
    > n = Val(Mid$(s, pos - 1, 1))
    > If n Then
    > If pos + 1 < Len(s) Then
    > If Mid$(s, pos + 2, 1) <> " " Then n = 0
    > End If
    > End If
    > If n > 0 Then
    > rCell.Characters(pos, 2).Font.Superscript = True
    > Exit For
    > End If
    > End If
    > Next
    > End If
    > End If
    > End If
    >End Sub
    >
    >Run Test() to process the active sheet
    >
    >If you want changes to update immediately, try this in a worksheet module
    >(right - click sheet tab, view code)
    >
    >Private Sub Worksheet_Change(ByVal Target As Range)
    > SuperNum Target(1)
    >End Sub
    >
    >Regards,
    >Peter T
    >
    >
    >
    >
    >"Mikhail Bogorad" <> wrote in message
    >news:...
    >> 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

    >
     
    Gord Dibben, Apr 15, 2010
    #5
  6. If the text in the cell has one of your ordinals with an actual word before
    the day number having that ordinal, then nothing will be superscripted. For
    example, if the text were one of these, then nothing gets superscripted...

    "Current start date is October 21st this year."

    "August 1st begins the month."

    "Hard start date: Jan 3rd."

    --
    Rick (MVP - Excel)



    "Peter T" <peter_t@discussions> wrote in message
    news:...
    > Try this in a normal module
    >
    > Option Explicit
    > Sub Test()
    > Dim rng As Range
    > Dim cel As Range
    >
    > On Error Resume Next
    > Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    > On Error GoTo 0
    > If Not rng Is Nothing Then
    > For Each cel In rng
    > SuperNum cel
    > Next
    > End If
    > End Sub
    >
    > Sub SuperNum(rCell As Range)
    > Dim n As Long, pos As Long
    > Dim s As String
    > Dim Target As Range
    > Dim vData, v, vFlag
    > Dim arr()
    >
    > arr = Array("th", "st", "rd")
    > Set Target = Selection
    > If rCell.HasFormula = False Then
    > vData = rCell.Value
    > If VarType(vData) = vbString Then
    > vFlag = rCell.Font.Superscript
    >
    > If IsNull(vFlag) Then vFlag = True
    > If vFlag Then rCell.Font.Superscript = False
    > s = rCell.Value
    > If Len(s) > 2 Then
    > For Each v In arr
    > pos = 0
    > pos = InStr(2, s, v)
    > If pos Then
    > n = Val(Mid$(s, pos - 1, 1))
    > If n Then
    > If pos + 1 < Len(s) Then
    > If Mid$(s, pos + 2, 1) <> " " Then n = 0
    > End If
    > End If
    > If n > 0 Then
    > rCell.Characters(pos, 2).Font.Superscript =
    > True
    > Exit For
    > End If
    > End If
    > Next
    > End If
    > End If
    > End If
    > End Sub
    >
    > Run Test() to process the active sheet
    >
    > If you want changes to update immediately, try this in a worksheet module
    > (right - click sheet tab, view code)
    >
    > Private Sub Worksheet_Change(ByVal Target As Range)
    > SuperNum Target(1)
    > End Sub
    >
    > Regards,
    > Peter T
    >
    >
    >
    >
    > "Mikhail Bogorad" <> wrote in message
    > news:...
    >> 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

    >
    >
     
    Rick Rothstein, Apr 15, 2010
    #6
  7. Mikhail Bogorad

    Peter T Guest

    Ah !
    Gord - best bin my original...

    FWIW, here's my original amended to cater for Rick's observations.

    Sub SuperNum(rCell As Range)
    Dim n As Long, pos As Long, start As Long
    Dim s As String, sNum As String
    Dim Target As Range
    Dim vData, v, vFlag
    Dim arr()

    arr = Array("th", "1st", "2nd", "3rd")

    Set Target = Selection
    If rCell.HasFormula = False Then
    vData = rCell.Value
    If VarType(vData) = vbString Then
    vFlag = rCell.Font.Superscript

    If IsNull(vFlag) Then vFlag = True
    If vFlag Then rCell.Font.Superscript = False
    s = rCell.Value
    If Len(s) > 2 Then
    For Each v In arr
    pos = 0
    start = 2
    pos = -1
    While pos
    pos = InStr(start, s, v)
    If pos Then
    sNum = Mid$(s, pos - 1, 1)

    n = Val(Mid$(s, pos - 1, 1))

    If n Then
    If pos + 1 < Len(s) Then
    If Mid$(s, pos + 2, 1) <> " " Then n = 0
    End If
    End If
    If n > 0 Then
    rCell.Characters(pos, 2).Font.Superscript =
    True

    pos = 0
    End If
    start = pos + 1
    End If
    Wend
    If n Then Exit For
    Next
    End If
    End If
    End If
    End Sub


    Regards,
    Peter T


    "Rick Rothstein" <> wrote in message
    news:...
    > If the text in the cell has one of your ordinals with an actual word
    > before the day number having that ordinal, then nothing will be
    > superscripted. For example, if the text were one of these, then nothing
    > gets superscripted...
    >
    > "Current start date is October 21st this year."
    >
    > "August 1st begins the month."
    >
    > "Hard start date: Jan 3rd."
    >
    > --
    > Rick (MVP - Excel)
    >
    >
    >
    > "Peter T" <peter_t@discussions> wrote in message
    > news:...
    >> Try this in a normal module
    >>
    >> Option Explicit
    >> Sub Test()
    >> Dim rng As Range
    >> Dim cel As Range
    >>
    >> On Error Resume Next
    >> Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    >> On Error GoTo 0
    >> If Not rng Is Nothing Then
    >> For Each cel In rng
    >> SuperNum cel
    >> Next
    >> End If
    >> End Sub
    >>
    >> Sub SuperNum(rCell As Range)
    >> Dim n As Long, pos As Long
    >> Dim s As String
    >> Dim Target As Range
    >> Dim vData, v, vFlag
    >> Dim arr()
    >>
    >> arr = Array("th", "st", "rd")
    >> Set Target = Selection
    >> If rCell.HasFormula = False Then
    >> vData = rCell.Value
    >> If VarType(vData) = vbString Then
    >> vFlag = rCell.Font.Superscript
    >>
    >> If IsNull(vFlag) Then vFlag = True
    >> If vFlag Then rCell.Font.Superscript = False
    >> s = rCell.Value
    >> If Len(s) > 2 Then
    >> For Each v In arr
    >> pos = 0
    >> pos = InStr(2, s, v)
    >> If pos Then
    >> n = Val(Mid$(s, pos - 1, 1))
    >> If n Then
    >> If pos + 1 < Len(s) Then
    >> If Mid$(s, pos + 2, 1) <> " " Then n = 0
    >> End If
    >> End If
    >> If n > 0 Then
    >> rCell.Characters(pos, 2).Font.Superscript =
    >> True
    >> Exit For
    >> End If
    >> End If
    >> Next
    >> End If
    >> End If
    >> End If
    >> End Sub
    >>
    >> Run Test() to process the active sheet
    >>
    >> If you want changes to update immediately, try this in a worksheet module
    >> (right - click sheet tab, view code)
    >>
    >> Private Sub Worksheet_Change(ByVal Target As Range)
    >> SuperNum Target(1)
    >> End Sub
    >>
    >> Regards,
    >> Peter T
    >>
    >>
    >>
    >>
    >> "Mikhail Bogorad" <> wrote in message
    >> news:...
    >>> 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

    >>
    >>
     
    Peter T, Apr 15, 2010
    #7
  8. Mikhail Bogorad

    Gord Dibben Guest

    Your testing was more thorough than mine Rick

    I see what you mean after more testing.



    Gord

    On Thu, 15 Apr 2010 15:43:28 -0400, "Rick Rothstein"
    <> wrote:

    >If the text in the cell has one of your ordinals with an actual word before
    >the day number having that ordinal, then nothing will be superscripted. For
    >example, if the text were one of these, then nothing gets superscripted...
    >
    >"Current start date is October 21st this year."
    >
    >"August 1st begins the month."
    >
    >"Hard start date: Jan 3rd."
     
    Gord Dibben, Apr 15, 2010
    #8
  9. On Thu, 15 Apr 2010 14:49:14 -0400, "Rick Rothstein"
    <> wrote:

    >If I can anticipate your complete requirements (for 1st, 2nd, 3rd, nth),
    >give this macro a try after the cells have been filled in with their text...
    >
    >Sub SuperScriptOrdinals()
    > Dim X As Long, NumPosition As Long, Cell As Range
    > For Each Cell In Range("B2:B15")
    > NumPosition = InStr(Cell.Value, "1st")
    > If NumPosition = 0 Then
    > NumPosition = InStr(Cell.Value, "2nd")
    > If NumPosition = 0 Then
    > NumPosition = InStr(Cell.Value, "3rd")
    > If NumPosition = 0 Then
    > For NumPosition = 1 To Len(Cell.Text)
    > If Mid(Cell.Value, NumPosition) Like "#th*" Then Exit For
    > Next
    > End If
    > End If
    > End If
    > If NumPosition Then
    > Cell.Characters(NumPosition + 1, 2).Font.Superscript = True
    > End If
    > Next
    >End Sub
    >
    >--
    >Rick (MVP - Excel)


    As you write, you are trying to anticipate the complete requirements.

    But I note that your routine does not completely error check for incorrect
    suffixes. For example, May 21th would have the "th" superscripted.



    --ron
     
    Ron Rosenfeld, Apr 16, 2010
    #9
  10. 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
     
    Ron Rosenfeld, Apr 16, 2010
    #10
  11. Mikhail Bogorad

    JLGWhiz Guest

    I had seen some code by Tom Ogilvy dealing with Ordinal numbers but nothing
    with Superscript or Subscript. It was just adding the two digit ordinal
    onto the numbers. I'll tuck this away for future reference. Thanks Peter.



    "Peter T" <peter_t@discussions> wrote in message
    news:uz%...
    > Ah !
    > Gord - best bin my original...
    >
    > FWIW, here's my original amended to cater for Rick's observations.
    >
    > Sub SuperNum(rCell As Range)
    > Dim n As Long, pos As Long, start As Long
    > Dim s As String, sNum As String
    > Dim Target As Range
    > Dim vData, v, vFlag
    > Dim arr()
    >
    > arr = Array("th", "1st", "2nd", "3rd")
    >
    > Set Target = Selection
    > If rCell.HasFormula = False Then
    > vData = rCell.Value
    > If VarType(vData) = vbString Then
    > vFlag = rCell.Font.Superscript
    >
    > If IsNull(vFlag) Then vFlag = True
    > If vFlag Then rCell.Font.Superscript = False
    > s = rCell.Value
    > If Len(s) > 2 Then
    > For Each v In arr
    > pos = 0
    > start = 2
    > pos = -1
    > While pos
    > pos = InStr(start, s, v)
    > If pos Then
    > sNum = Mid$(s, pos - 1, 1)
    >
    > n = Val(Mid$(s, pos - 1, 1))
    >
    > If n Then
    > If pos + 1 < Len(s) Then
    > If Mid$(s, pos + 2, 1) <> " " Then n =
    > 0
    > End If
    > End If
    > If n > 0 Then
    > rCell.Characters(pos, 2).Font.Superscript =
    > True
    >
    > pos = 0
    > End If
    > start = pos + 1
    > End If
    > Wend
    > If n Then Exit For
    > Next
    > End If
    > End If
    > End If
    > End Sub
    >
    >
    > Regards,
    > Peter T
    >
    >
    > "Rick Rothstein" <> wrote in message
    > news:...
    >> If the text in the cell has one of your ordinals with an actual word
    >> before the day number having that ordinal, then nothing will be
    >> superscripted. For example, if the text were one of these, then nothing
    >> gets superscripted...
    >>
    >> "Current start date is October 21st this year."
    >>
    >> "August 1st begins the month."
    >>
    >> "Hard start date: Jan 3rd."
    >>
    >> --
    >> Rick (MVP - Excel)
    >>
    >>
    >>
    >> "Peter T" <peter_t@discussions> wrote in message
    >> news:...
    >>> Try this in a normal module
    >>>
    >>> Option Explicit
    >>> Sub Test()
    >>> Dim rng As Range
    >>> Dim cel As Range
    >>>
    >>> On Error Resume Next
    >>> Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    >>> On Error GoTo 0
    >>> If Not rng Is Nothing Then
    >>> For Each cel In rng
    >>> SuperNum cel
    >>> Next
    >>> End If
    >>> End Sub
    >>>
    >>> Sub SuperNum(rCell As Range)
    >>> Dim n As Long, pos As Long
    >>> Dim s As String
    >>> Dim Target As Range
    >>> Dim vData, v, vFlag
    >>> Dim arr()
    >>>
    >>> arr = Array("th", "st", "rd")
    >>> Set Target = Selection
    >>> If rCell.HasFormula = False Then
    >>> vData = rCell.Value
    >>> If VarType(vData) = vbString Then
    >>> vFlag = rCell.Font.Superscript
    >>>
    >>> If IsNull(vFlag) Then vFlag = True
    >>> If vFlag Then rCell.Font.Superscript = False
    >>> s = rCell.Value
    >>> If Len(s) > 2 Then
    >>> For Each v In arr
    >>> pos = 0
    >>> pos = InStr(2, s, v)
    >>> If pos Then
    >>> n = Val(Mid$(s, pos - 1, 1))
    >>> If n Then
    >>> If pos + 1 < Len(s) Then
    >>> If Mid$(s, pos + 2, 1) <> " " Then n = 0
    >>> End If
    >>> End If
    >>> If n > 0 Then
    >>> rCell.Characters(pos, 2).Font.Superscript =
    >>> True
    >>> Exit For
    >>> End If
    >>> End If
    >>> Next
    >>> End If
    >>> End If
    >>> End If
    >>> End Sub
    >>>
    >>> Run Test() to process the active sheet
    >>>
    >>> If you want changes to update immediately, try this in a worksheet
    >>> module (right - click sheet tab, view code)
    >>>
    >>> Private Sub Worksheet_Change(ByVal Target As Range)
    >>> SuperNum Target(1)
    >>> End Sub
    >>>
    >>> Regards,
    >>> Peter T
    >>>
    >>>
    >>>
    >>>
    >>> "Mikhail Bogorad" <> wrote in message
    >>> news:...
    >>>> 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
    >>>
    >>>

    >
    >
     
    JLGWhiz, Apr 16, 2010
    #11
  12. Mikhail Bogorad

    Peter T Guest

    JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
    correctly, following also caters for multiple ordinals

    test string
    "August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"

    Sub Test1()
    Dim rng As Range
    Dim cel As Range

    On Error Resume Next
    Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    On Error GoTo 0
    If Not rng Is Nothing Then
    For Each cel In rng
    SuperNum cel
    Next
    End If
    End Sub

    Sub test2()
    SuperNum ActiveCell
    End Sub

    Sub SuperNum(rCell As Range)
    Dim n As Long, pos As Long, start As Long
    Dim s As String, sNum As String
    Dim Target As Range
    Dim vData, v, vFlag
    Dim arr()

    arr = Array("th", "st", "nd", "rd")

    Set Target = Selection
    If rCell.HasFormula = False Then
    vData = rCell.Value
    If VarType(vData) = vbString Then
    vFlag = rCell.Font.Superscript

    If IsNull(vFlag) Then vFlag = True
    If vFlag Then rCell.Font.Superscript = False
    s = rCell.Value
    If Len(s) > 2 Then
    For Each v In arr
    pos = 0
    start = 2
    pos = -1
    While pos
    pos = InStr(start, s, v)
    If pos Then
    sNum = Mid$(s, pos - 1, 1)

    n = Val(sNum)
    If n = 0 Then
    If sNum = "0" Then n = -1
    End If

    If n Then
    If pos + 1 < Len(s) Then
    If Mid$(s, pos + 2, 1) _
    Like "[ ,]" = False Then n = 0
    End If
    End If
    If n Then
    rCell.Characters(pos, 2).Font.Superscript =
    True
    End If
    start = pos + 1
    End If
    Wend
    Next
    End If
    End If
    End If
    End Sub

    re Like "[ ,]"
    include any other characters that might be allowed after an ordinal, such as
    space or comma.

    Looks like a lot of code but I think it should be the fastest approach here

    Regards,
    Peter T


    "Peter T" <peter_t@discussions> wrote in message
    news:uz%...
    > Ah !
    > Gord - best bin my original...
    >
    > FWIW, here's my original amended to cater for Rick's observations.
    >
    > Sub SuperNum(rCell As Range)
    > Dim n As Long, pos As Long, start As Long
    > Dim s As String, sNum As String
    > Dim Target As Range
    > Dim vData, v, vFlag
    > Dim arr()
    >
    > arr = Array("th", "1st", "2nd", "3rd")
    >
    > Set Target = Selection
    > If rCell.HasFormula = False Then
    > vData = rCell.Value
    > If VarType(vData) = vbString Then
    > vFlag = rCell.Font.Superscript
    >
    > If IsNull(vFlag) Then vFlag = True
    > If vFlag Then rCell.Font.Superscript = False
    > s = rCell.Value
    > If Len(s) > 2 Then
    > For Each v In arr
    > pos = 0
    > start = 2
    > pos = -1
    > While pos
    > pos = InStr(start, s, v)
    > If pos Then
    > sNum = Mid$(s, pos - 1, 1)
    >
    > n = Val(Mid$(s, pos - 1, 1))
    >
    > If n Then
    > If pos + 1 < Len(s) Then
    > If Mid$(s, pos + 2, 1) <> " " Then n =
    > 0
    > End If
    > End If
    > If n > 0 Then
    > rCell.Characters(pos, 2).Font.Superscript =
    > True
    >
    > pos = 0
    > End If
    > start = pos + 1
    > End If
    > Wend
    > If n Then Exit For
    > Next
    > End If
    > End If
    > End If
    > End Sub
    >
    >
    > Regards,
    > Peter T
    >
    >
    > "Rick Rothstein" <> wrote in message
    > news:...
    >> If the text in the cell has one of your ordinals with an actual word
    >> before the day number having that ordinal, then nothing will be
    >> superscripted. For example, if the text were one of these, then nothing
    >> gets superscripted...
    >>
    >> "Current start date is October 21st this year."
    >>
    >> "August 1st begins the month."
    >>
    >> "Hard start date: Jan 3rd."
    >>
    >> --
    >> Rick (MVP - Excel)
    >>
    >>
    >>
    >> "Peter T" <peter_t@discussions> wrote in message
    >> news:...
    >>> Try this in a normal module
    >>>
    >>> Option Explicit
    >>> Sub Test()
    >>> Dim rng As Range
    >>> Dim cel As Range
    >>>
    >>> On Error Resume Next
    >>> Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    >>> On Error GoTo 0
    >>> If Not rng Is Nothing Then
    >>> For Each cel In rng
    >>> SuperNum cel
    >>> Next
    >>> End If
    >>> End Sub
    >>>
    >>> Sub SuperNum(rCell As Range)
    >>> Dim n As Long, pos As Long
    >>> Dim s As String
    >>> Dim Target As Range
    >>> Dim vData, v, vFlag
    >>> Dim arr()
    >>>
    >>> arr = Array("th", "st", "rd")
    >>> Set Target = Selection
    >>> If rCell.HasFormula = False Then
    >>> vData = rCell.Value
    >>> If VarType(vData) = vbString Then
    >>> vFlag = rCell.Font.Superscript
    >>>
    >>> If IsNull(vFlag) Then vFlag = True
    >>> If vFlag Then rCell.Font.Superscript = False
    >>> s = rCell.Value
    >>> If Len(s) > 2 Then
    >>> For Each v In arr
    >>> pos = 0
    >>> pos = InStr(2, s, v)
    >>> If pos Then
    >>> n = Val(Mid$(s, pos - 1, 1))
    >>> If n Then
    >>> If pos + 1 < Len(s) Then
    >>> If Mid$(s, pos + 2, 1) <> " " Then n = 0
    >>> End If
    >>> End If
    >>> If n > 0 Then
    >>> rCell.Characters(pos, 2).Font.Superscript =
    >>> True
    >>> Exit For
    >>> End If
    >>> End If
    >>> Next
    >>> End If
    >>> End If
    >>> End If
    >>> End Sub
    >>>
    >>> Run Test() to process the active sheet
    >>>
    >>> If you want changes to update immediately, try this in a worksheet
    >>> module (right - click sheet tab, view code)
    >>>
    >>> Private Sub Worksheet_Change(ByVal Target As Range)
    >>> SuperNum Target(1)
    >>> End Sub
    >>>
    >>> Regards,
    >>> Peter T
    >>>
    >>>
    >>>
    >>>
    >>> "Mikhail Bogorad" <> wrote in message
    >>> news:...
    >>>> 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
    >>>
    >>>

    >
    >
     
    Peter T, Apr 16, 2010
    #12
  13. 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
     
    Ron Rosenfeld, Apr 16, 2010
    #13
  14. On Fri, 16 Apr 2010 10:08:05 +0100, "Peter T" <peter_t@discussions> wrote:

    >JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
    >correctly, following also caters for multiple ordinals
    >
    >test string
    >"August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"
    >
    >Sub Test1()
    >Dim rng As Range
    >Dim cel As Range
    >
    > On Error Resume Next
    > Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    > On Error GoTo 0
    > If Not rng Is Nothing Then
    > For Each cel In rng
    > SuperNum cel
    > Next
    > End If
    >End Sub
    >
    >Sub test2()
    > SuperNum ActiveCell
    >End Sub
    >
    >Sub SuperNum(rCell As Range)
    >Dim n As Long, pos As Long, start As Long
    >Dim s As String, sNum As String
    >Dim Target As Range
    >Dim vData, v, vFlag
    >Dim arr()
    >
    > arr = Array("th", "st", "nd", "rd")
    >
    > Set Target = Selection
    > If rCell.HasFormula = False Then
    > vData = rCell.Value
    > If VarType(vData) = vbString Then
    > vFlag = rCell.Font.Superscript
    >
    > If IsNull(vFlag) Then vFlag = True
    > If vFlag Then rCell.Font.Superscript = False
    > s = rCell.Value
    > If Len(s) > 2 Then
    > For Each v In arr
    > pos = 0
    > start = 2
    > pos = -1
    > While pos
    > pos = InStr(start, s, v)
    > If pos Then
    > sNum = Mid$(s, pos - 1, 1)
    >
    > n = Val(sNum)
    > If n = 0 Then
    > If sNum = "0" Then n = -1
    > End If
    >
    > If n Then
    > If pos + 1 < Len(s) Then
    > If Mid$(s, pos + 2, 1) _
    > Like "[ ,]" = False Then n = 0
    > End If
    > End If
    > If n Then
    > rCell.Characters(pos, 2).Font.Superscript =
    >True
    > End If
    > start = pos + 1
    > End If
    > Wend
    > Next
    > End If
    > End If
    > End If
    >End Sub
    >
    >re Like "[ ,]"
    >include any other characters that might be allowed after an ordinal, such as
    >space or comma.
    >
    >Looks like a lot of code but I think it should be the fastest approach here
    >
    >Regards,
    >Peter T


    This will superscript the ordinal even if it is not the correct one for the
    value.

    It also fails to recognize some legitimate constructs

    E.g. Test strings

    "101th vs 101st"
    "May 21st-Jun 16th"




    --ron
     
    Ron Rosenfeld, Apr 16, 2010
    #14
  15. Mikhail Bogorad

    Peter T Guest

    "Ron Rosenfeld" <> wrote in message
    news:...
    > On Fri, 16 Apr 2010 10:08:05 +0100, "Peter T" <peter_t@discussions> wrote:
    >
    >>JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
    >>correctly, following also caters for multiple ordinals
    >>
    >>test string
    >>"August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"
    >>
    >>Sub Test1()
    >>Dim rng As Range
    >>Dim cel As Range
    >>
    >> On Error Resume Next
    >> Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
    >> On Error GoTo 0
    >> If Not rng Is Nothing Then
    >> For Each cel In rng
    >> SuperNum cel
    >> Next
    >> End If
    >>End Sub
    >>
    >>Sub test2()
    >> SuperNum ActiveCell
    >>End Sub
    >>
    >>Sub SuperNum(rCell As Range)
    >>Dim n As Long, pos As Long, start As Long
    >>Dim s As String, sNum As String
    >>Dim Target As Range
    >>Dim vData, v, vFlag
    >>Dim arr()
    >>
    >> arr = Array("th", "st", "nd", "rd")
    >>
    >> Set Target = Selection
    >> If rCell.HasFormula = False Then
    >> vData = rCell.Value
    >> If VarType(vData) = vbString Then
    >> vFlag = rCell.Font.Superscript
    >>
    >> If IsNull(vFlag) Then vFlag = True
    >> If vFlag Then rCell.Font.Superscript = False
    >> s = rCell.Value
    >> If Len(s) > 2 Then
    >> For Each v In arr
    >> pos = 0
    >> start = 2
    >> pos = -1
    >> While pos
    >> pos = InStr(start, s, v)
    >> If pos Then
    >> sNum = Mid$(s, pos - 1, 1)
    >>
    >> n = Val(sNum)
    >> If n = 0 Then
    >> If sNum = "0" Then n = -1
    >> End If
    >>
    >> If n Then
    >> If pos + 1 < Len(s) Then
    >> If Mid$(s, pos + 2, 1) _
    >> Like "[ ,]" = False Then n = 0
    >> End If
    >> End If
    >> If n Then
    >> rCell.Characters(pos, 2).Font.Superscript
    >> =
    >>True
    >> End If
    >> start = pos + 1
    >> End If
    >> Wend
    >> Next
    >> End If
    >> End If
    >> End If
    >>End Sub
    >>
    >>re Like "[ ,]"
    >>include any other characters that might be allowed after an ordinal, such
    >>as
    >>space or comma.
    >>
    >>Looks like a lot of code but I think it should be the fastest approach
    >>here
    >>
    >>Regards,
    >>Peter T

    >
    > This will superscript the ordinal even if it is not the correct one for
    > the
    > value.


    I had thought of that and could be adapted (the previous version did) but
    thought probably not worth bothering with

    > It also fails to recognize some legitimate constructs
    >
    > E.g. Test strings
    >
    > "101th vs 101st"
    > "May 21st-Jun 16th"


    To cater for that particular one, ie the dash, amend the Like string as I
    had suggested previously -

    Like "[ ,-]" = False Then n = 0

    Now let me pop over to yours and make a suggestion :)

    Regards,
    Peter Thornton
     
    Peter T, Apr 16, 2010
    #15
  16. Mikhail Bogorad

    Peter T Guest

    "Ron Rosenfeld" <> wrote in message
    news:...
    > 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
     
    Peter T, Apr 16, 2010
    #16
  17. 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
     
    Ron Rosenfeld, Apr 16, 2010
    #17
  18. You may want to try John Walkenbach's addin:
    http://j-walk.com/ss/excel/files/supersub.htm

    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


    --

    Dave Peterson
     
    Dave Peterson, Apr 16, 2010
    #18
  19. On Apr 16, 8:04 am, Dave Peterson <> wrote:
    > You  may want to try John Walkenbach's addin:http://j-walk.com/ss/excel/files/supersub.htm
    >
    > 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

    >
    > --
    >
    > Dave Peterson


    Thanks guys, i'll test your suggestions and let you know. In my report
    it can only be "1st" no "2nd" or "3rd" but thanks anyways.
     
    Mikhail Bogorad, Apr 16, 2010
    #19
  20. > Thanks guys, i'll test your suggestions and let you know. In my report
    > it can only be "1st" no "2nd" or "3rd" but thanks anyways.


    In that case, the macro code can be reduced to this...

    Sub SuperScriptOrdinals()
    Dim X As Long, Position As Long, C As Range
    For Each C In Range("B2:B15")
    Position = InStr(C.Value, "1st")
    If Position Then C.Characters(Position + 1, 2).Font.Superscript = True
    Next
    End Sub

    --
    Rick (MVP - Excel)
     
    Rick Rothstein, Apr 16, 2010
    #20
    1. Advertisements

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. ivan

    retaining superscript after a cell merge using =text

    ivan, Jul 24, 2003, in forum: Microsoft Excel Programming
    Replies:
    0
    Views:
    267
  2. ¬f©÷
    Replies:
    1
    Views:
    325
    Dave Peterson
    Nov 7, 2004
  3. CAPTGNVR
    Replies:
    2
    Views:
    814
    Gary Keramidas
    Jul 8, 2007
  4. Phrank

    Superscript/subscript selected text within a cell

    Phrank, Aug 7, 2007, in forum: Microsoft Excel Programming
    Replies:
    3
    Views:
    319
    Phrank
    Aug 8, 2007
  5. irishcab

    VBA Compare part of cell to another cell and then calculate

    irishcab, Oct 11, 2011, in forum: Microsoft Excel Programming
    Replies:
    0
    Views:
    400
    irishcab
    Oct 11, 2011
Loading...

Share This Page