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