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
...
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
...
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
...
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