How to subscript "yr" & "mo" in excel ages column, without altering numbers (ages)

[vbanoob2011]

Hello,

I have a Macbook Pro with Excel 2010. What I don't have is ANY VBA/macros expertise.

In column Q I have a list of varying ages written as "32y 6m" as in 32 years and 6 months. I would like to Subscript the "y" and the "m" but NOT the numbers (i.e. "32" or the "6"), though all are located in one cell.

In column R, I have a list of school grades "1st, 2nd, 3rd, 4th, etc." I googled and copied and pasted dozens of macro codes to Superscript the suffixes "st", "nd", "rd", "th" but NOT the numbers "1,2,3,4", and finally found one that works for me without any errors (pasted below).

I figure a modification of this macro would be best for my second wish, (so the macro looks for "y" and "m" and instead commands to Subscript, but since some of the numbers overlap (i.e. 10 can be 10y or 10m) I don't know how to specify to keep the y's and m's where they are, only to subscript them.

Does someone know how to accomplish this?

Thank you so much for reading this...



Sub SuperscriptOrdinals()
Dim X As Long, Position As Long, Ordinal As String, Cell As Range, OK As Boolean
For Each Cell In Selection
For X = 1 To 4
Ordinal = Choose(X, "st", "nd", "rd", "th")
Position = InStr(1, Cell.Value & Ordinal, Ordinal, vbTextCompare)
Do While Position < Len(Cell.Value)
If Position > 1 Then
If UCase(Mid(" " & Cell.Value & " ", Position, 4)) Like "#" & UCase(Ordinal) & "[!A-Z0-9]" Then
If Position > 2 Then
If Mid(Cell.Value, Position - 2, 1) = 1 Then
OK = Ordinal = "th"
GoTo Continue
End If
End If
If Not OK Then
Select Case Mid(Cell.Value, Position - 1, 1)
Case 1: OK = Ordinal = "st"
Case 2: OK = Ordinal = "nd"
Case 3: OK = Ordinal = "rd"
Case Else: OK = Ordinal = "th"
End Select
End If
Continue: Cell.Characters(Position, 2).Font.Superscript = OK
End If
End If
Position = InStr(Position + 1, Cell.Value & Ordinal, Ordinal, vbTextCompare)
Loop
Next
Next
End Sub

 

[VoG]

Try

Sub sscript()
Dim c As Range, i As Long
For Each c In Selection
    For i = 1 To Len(c.Value)
        If Not IsNumeric(Mid(c, i, 1)) Then c.Characters(i, 1).Font.Subscript = True
    Next i
Next c
End Sub

 

[vbanoob2011]

Try

Sub sscript()
Dim c As Range, i As Long
For Each c In Selection
    For i = 1 To Len(c.Value)
        If Not IsNumeric(Mid(c, i, 1)) Then c.Characters(i, 1).Font.Subscript = True
    Next i
Next c
End Sub

PERFECT! thank you so much!