How to make all instances of certain text superscript?

Question

How do I loop through a Word document using find and replace to make all instances of certain text superscript?

I tried For Each a number of ways.

Sub Find()

    Dim Rng As Range
    Dim Fnd As Boolean

    Set Rng = Selection.Range
    With Rng.Find
        .ClearFormatting
        .Execute FindText:="4th", Forward:=True, _
                 Format:=False, Wrap:=wdFindStop
        Fnd = .Found
    End With

    If Fnd = True Then
        With Rng
            .MoveStart wdCharacter, 1
            .Font.Superscript = True
        End With
    End If
    
    Do Until Fnd = False
        With Rng.Find
            .ClearFormatting
            .Execute FindText:="4th", Forward:=True, _
                     Format:=False, Wrap:=wdFindStop
            Fnd = .Found
        End With

        If Fnd = True Then
            With Rng
                .MoveStart wdCharacter, 1
                .Font.Superscript = True
            End With
        End If
    Loop

End Sub

I expect it to change the last two characters of each instance of '4th'. It changes the first instance and ends.

Ultimately, I want to change all instances of the last two characters of 1st, 2nd, 3rd etc. to superscript. I couldn't find a wildcard to do this. Is it possible using a wildcard?

Answer 1

ok, here's my second attempt, uses word's autoformat feature - also - i'm no expert!!

• gets each option for later
• set each option to false - except AutoFormatReplaceOrdinals
• autoformats the document
• sets each option back to what it was

double check your document afterwards just to make sure that autoformat hasn't nerfed everything!

Private Sub AutoFormat_Make_Ordinal_Suffixes_Superscript()
'
' affects ALL document content - body and tables
'
' get autoformat options into array
' set autoformat options to false except AutoFormatReplaceOrdinals = True
' autoformat the document
' set autoformat options back to what they were
'
' WARNING: autoformat will affect ADD extra document content
' ie., headings/numbering/list continue/extra styles
'
' https://stackoverflow.com/questions/58172914/how-to-make-all-instances-of-certain-text-superscript
' https://www.tek-tips.com/viewthread.cfm?qid=1121138
' https://docs.microsoft.com/en-us/office/vba/api/word.options
'
    Dim arrAutoFormatOptions(38)
    Dim StartTime As Single
    StartTime = Timer
    
    ' read all autoformat options
    arrAutoFormatOptions(0) = Options.AutoFormatApplyBulletedLists
    arrAutoFormatOptions(1) = Options.AutoFormatApplyFirstIndents
    arrAutoFormatOptions(2) = Options.AutoFormatApplyHeadings
    arrAutoFormatOptions(3) = Options.AutoFormatApplyLists
    arrAutoFormatOptions(4) = Options.AutoFormatApplyOtherParas
    arrAutoFormatOptions(5) = Options.AutoFormatAsYouTypeApplyBorders
    arrAutoFormatOptions(6) = Options.AutoFormatAsYouTypeApplyBulletedLists
    arrAutoFormatOptions(7) = Options.AutoFormatAsYouTypeApplyClosings
    arrAutoFormatOptions(8) = Options.AutoFormatAsYouTypeApplyDates
    arrAutoFormatOptions(9) = Options.AutoFormatAsYouTypeApplyFirstIndents
    arrAutoFormatOptions(10) = Options.AutoFormatAsYouTypeApplyHeadings
    arrAutoFormatOptions(11) = Options.AutoFormatAsYouTypeApplyNumberedLists
    arrAutoFormatOptions(12) = Options.AutoFormatAsYouTypeApplyTables
    arrAutoFormatOptions(13) = Options.AutoFormatAsYouTypeAutoLetterWizard
    arrAutoFormatOptions(14) = Options.AutoFormatAsYouTypeDefineStyles
    arrAutoFormatOptions(15) = Options.AutoFormatAsYouTypeDeleteAutoSpaces
    arrAutoFormatOptions(16) = Options.AutoFormatAsYouTypeFormatListItemBeginning
    arrAutoFormatOptions(17) = Options.AutoFormatAsYouTypeInsertClosings
    arrAutoFormatOptions(18) = Options.AutoFormatAsYouTypeInsertOvers
    arrAutoFormatOptions(19) = Options.AutoFormatAsYouTypeMatchParentheses
    arrAutoFormatOptions(20) = Options.AutoFormatAsYouTypeReplaceFarEastDashes
    arrAutoFormatOptions(21) = Options.AutoFormatAsYouTypeReplaceFractions
    arrAutoFormatOptions(22) = Options.AutoFormatAsYouTypeReplaceHyperlinks
    arrAutoFormatOptions(23) = Options.AutoFormatAsYouTypeReplaceOrdinals
    arrAutoFormatOptions(24) = Options.AutoFormatAsYouTypeReplacePlainTextEmphasis
    arrAutoFormatOptions(25) = Options.AutoFormatAsYouTypeReplaceQuotes
    arrAutoFormatOptions(26) = Options.AutoFormatAsYouTypeReplaceSymbols
    arrAutoFormatOptions(27) = Options.AutoFormatDeleteAutoSpaces
    arrAutoFormatOptions(28) = Options.AutoFormatMatchParentheses
    arrAutoFormatOptions(29) = Options.AutoFormatPlainTextWordMail
    arrAutoFormatOptions(30) = Options.AutoFormatPreserveStyles
    arrAutoFormatOptions(31) = Options.AutoFormatReplaceFarEastDashes
    arrAutoFormatOptions(32) = Options.AutoFormatReplaceFractions
    arrAutoFormatOptions(33) = Options.AutoFormatReplaceHyperlinks
    arrAutoFormatOptions(34) = Options.AutoFormatReplaceOrdinals
    arrAutoFormatOptions(35) = Options.AutoFormatReplacePlainTextEmphasis
    arrAutoFormatOptions(36) = Options.AutoFormatReplaceQuotes
    arrAutoFormatOptions(37) = Options.AutoFormatReplaceSymbols

    ' disable all autoformat options
    With Options
        .AutoFormatApplyBulletedLists = False
        .AutoFormatApplyFirstIndents = False
        .AutoFormatApplyHeadings = False
        .AutoFormatApplyLists = False
        .AutoFormatApplyOtherParas = False
        .AutoFormatAsYouTypeApplyBorders = False
        .AutoFormatAsYouTypeApplyBulletedLists = False
        .AutoFormatAsYouTypeApplyClosings = False
        .AutoFormatAsYouTypeApplyDates = False
        .AutoFormatAsYouTypeApplyFirstIndents = False
        .AutoFormatAsYouTypeApplyHeadings = False
        .AutoFormatAsYouTypeApplyNumberedLists = False
        .AutoFormatAsYouTypeApplyTables = False
        .AutoFormatAsYouTypeAutoLetterWizard = False
        .AutoFormatAsYouTypeDefineStyles = False
        .AutoFormatAsYouTypeDeleteAutoSpaces = False
        .AutoFormatAsYouTypeFormatListItemBeginning = False
        .AutoFormatAsYouTypeInsertClosings = False
        .AutoFormatAsYouTypeInsertOvers = False
        .AutoFormatAsYouTypeMatchParentheses = False
        .AutoFormatAsYouTypeReplaceFarEastDashes = False
        .AutoFormatAsYouTypeReplaceFractions = False
        .AutoFormatAsYouTypeReplaceHyperlinks = False
        .AutoFormatAsYouTypeReplaceOrdinals = False
        .AutoFormatAsYouTypeReplacePlainTextEmphasis = False
        .AutoFormatAsYouTypeReplaceQuotes = False
        .AutoFormatAsYouTypeReplaceSymbols = False
        .AutoFormatDeleteAutoSpaces = False
        .AutoFormatMatchParentheses = False
        .AutoFormatPlainTextWordMail = False
        .AutoFormatPreserveStyles = False
        .AutoFormatReplaceFarEastDashes = False
        .AutoFormatReplaceFractions = False
        .AutoFormatReplaceHyperlinks = False
        .AutoFormatReplaceOrdinals = True   ' true
        .AutoFormatReplacePlainTextEmphasis = False
        .AutoFormatReplaceQuotes = False
        .AutoFormatReplaceSymbols = False
    End With
    
    ' do the autoformat
    Selection.Range.AutoFormat
    
    ' revert all autoformat options
    With Options
        .AutoFormatApplyBulletedLists = arrAutoFormatOptions(0)
        .AutoFormatApplyFirstIndents = arrAutoFormatOptions(1)
        .AutoFormatApplyHeadings = arrAutoFormatOptions(2)
        .AutoFormatApplyLists = arrAutoFormatOptions(3)
        .AutoFormatApplyOtherParas = arrAutoFormatOptions(4)
        .AutoFormatAsYouTypeApplyBorders = arrAutoFormatOptions(5)
        .AutoFormatAsYouTypeApplyBulletedLists = arrAutoFormatOptions(6)
        .AutoFormatAsYouTypeApplyClosings = arrAutoFormatOptions(7)
        .AutoFormatAsYouTypeApplyDates = arrAutoFormatOptions(8)
        .AutoFormatAsYouTypeApplyFirstIndents = arrAutoFormatOptions(9)
        .AutoFormatAsYouTypeApplyHeadings = arrAutoFormatOptions(10)
        .AutoFormatAsYouTypeApplyNumberedLists = arrAutoFormatOptions(11)
        .AutoFormatAsYouTypeApplyTables = arrAutoFormatOptions(12)
        .AutoFormatAsYouTypeAutoLetterWizard = arrAutoFormatOptions(13)
        .AutoFormatAsYouTypeDefineStyles = arrAutoFormatOptions(14)
        .AutoFormatAsYouTypeDeleteAutoSpaces = arrAutoFormatOptions(15)
        .AutoFormatAsYouTypeFormatListItemBeginning = arrAutoFormatOptions(16)
        .AutoFormatAsYouTypeInsertClosings = arrAutoFormatOptions(17)
        .AutoFormatAsYouTypeInsertOvers = arrAutoFormatOptions(18)
        .AutoFormatAsYouTypeMatchParentheses = arrAutoFormatOptions(19)
        .AutoFormatAsYouTypeReplaceFarEastDashes = arrAutoFormatOptions(20)
        .AutoFormatAsYouTypeReplaceFractions = arrAutoFormatOptions(21)
        .AutoFormatAsYouTypeReplaceHyperlinks = arrAutoFormatOptions(22)
        .AutoFormatAsYouTypeReplaceOrdinals = arrAutoFormatOptions(23)
        .AutoFormatAsYouTypeReplacePlainTextEmphasis = arrAutoFormatOptions(24)
        .AutoFormatAsYouTypeReplaceQuotes = arrAutoFormatOptions(25)
        .AutoFormatAsYouTypeReplaceSymbols = arrAutoFormatOptions(26)
        .AutoFormatDeleteAutoSpaces = arrAutoFormatOptions(27)
        .AutoFormatMatchParentheses = arrAutoFormatOptions(28)
        .AutoFormatPlainTextWordMail = arrAutoFormatOptions(29)
        .AutoFormatPreserveStyles = arrAutoFormatOptions(30)
        .AutoFormatReplaceFarEastDashes = arrAutoFormatOptions(31)
        .AutoFormatReplaceFractions = arrAutoFormatOptions(32)
        .AutoFormatReplaceHyperlinks = arrAutoFormatOptions(33)
        .AutoFormatReplaceOrdinals = arrAutoFormatOptions(34)
        .AutoFormatReplacePlainTextEmphasis = arrAutoFormatOptions(35)
        .AutoFormatReplaceQuotes = arrAutoFormatOptions(36)
        .AutoFormatReplaceSymbols = arrAutoFormatOptions(37)
    End With
    
'''    ' sanity check
'''    With Options
'''        'Debug.Print "AutoFormatReplaceOrdinals: "; .AutoFormatReplaceOrdinals
'''        Debug.Print "AutoFormatApplyBulletedLists: "; .AutoFormatApplyBulletedLists
'''        Debug.Print "AutoFormatApplyFirstIndents: "; .AutoFormatApplyFirstIndents
'''        Debug.Print "AutoFormatApplyHeadings: "; .AutoFormatApplyHeadings
'''        Debug.Print "AutoFormatApplyLists: "; .AutoFormatApplyLists
'''        Debug.Print "AutoFormatApplyOtherParas: "; .AutoFormatApplyOtherParas
'''        Debug.Print "AutoFormatAsYouTypeApplyBorders: "; .AutoFormatAsYouTypeApplyBorders
'''        Debug.Print "AutoFormatAsYouTypeApplyBulletedLists: "; .AutoFormatAsYouTypeApplyBulletedLists
'''        Debug.Print "AutoFormatAsYouTypeApplyClosings: "; .AutoFormatAsYouTypeApplyClosings
'''        Debug.Print "AutoFormatAsYouTypeApplyDates: "; .AutoFormatAsYouTypeApplyDates
'''        Debug.Print "AutoFormatAsYouTypeApplyFirstIndents: "; .AutoFormatAsYouTypeApplyFirstIndents
'''        Debug.Print "AutoFormatAsYouTypeApplyHeadings: "; .AutoFormatAsYouTypeApplyHeadings
'''        Debug.Print "AutoFormatAsYouTypeApplyNumberedLists: "; .AutoFormatAsYouTypeApplyNumberedLists
'''        Debug.Print "AutoFormatAsYouTypeApplyTables: "; .AutoFormatAsYouTypeApplyTables
'''        Debug.Print "AutoFormatAsYouTypeAutoLetterWizard: "; .AutoFormatAsYouTypeAutoLetterWizard
'''        Debug.Print "AutoFormatAsYouTypeDefineStyles: "; .AutoFormatAsYouTypeDefineStyles
'''        Debug.Print "AutoFormatAsYouTypeDeleteAutoSpaces: "; .AutoFormatAsYouTypeDeleteAutoSpaces
'''        Debug.Print "AutoFormatAsYouTypeFormatListItemBeginning: "; .AutoFormatAsYouTypeFormatListItemBeginning
'''        Debug.Print "AutoFormatAsYouTypeInsertClosings: "; .AutoFormatAsYouTypeInsertClosings
'''        Debug.Print "AutoFormatAsYouTypeInsertOvers: "; .AutoFormatAsYouTypeInsertOvers
'''        Debug.Print "AutoFormatAsYouTypeMatchParentheses: "; .AutoFormatAsYouTypeMatchParentheses
'''        Debug.Print "AutoFormatAsYouTypeReplaceFarEastDashes: "; .AutoFormatAsYouTypeReplaceFarEastDashes
'''        Debug.Print "AutoFormatAsYouTypeReplaceFractions: "; .AutoFormatAsYouTypeReplaceFractions
'''        Debug.Print "AutoFormatAsYouTypeReplaceHyperlinks: "; .AutoFormatAsYouTypeReplaceHyperlinks
'''        Debug.Print "AutoFormatAsYouTypeReplaceOrdinals: "; .AutoFormatAsYouTypeReplaceOrdinals
'''        Debug.Print "AutoFormatAsYouTypeReplacePlainTextEmphasis: "; .AutoFormatAsYouTypeReplacePlainTextEmphasis
'''        Debug.Print "AutoFormatAsYouTypeReplaceQuotes: "; .AutoFormatAsYouTypeReplaceQuotes
'''        Debug.Print "AutoFormatAsYouTypeReplaceSymbols: "; .AutoFormatAsYouTypeReplaceSymbols
'''        Debug.Print "AutoFormatDeleteAutoSpaces: "; .AutoFormatDeleteAutoSpaces
'''        Debug.Print "AutoFormatMatchParentheses: "; .AutoFormatMatchParentheses
'''        Debug.Print "AutoFormatPlainTextWordMail: "; .AutoFormatPlainTextWordMail
'''        Debug.Print "AutoFormatPreserveStyles: "; .AutoFormatPreserveStyles
'''        Debug.Print "AutoFormatReplaceFarEastDashes: "; .AutoFormatReplaceFarEastDashes
'''        Debug.Print "AutoFormatReplaceFractions: "; .AutoFormatReplaceFractions
'''        Debug.Print "AutoFormatReplaceHyperlinks: "; .AutoFormatReplaceHyperlinks
'''        Debug.Print "AutoFormatReplaceOrdinals: "; .AutoFormatReplaceOrdinals
'''        Debug.Print "AutoFormatReplacePlainTextEmphasis: "; .AutoFormatReplacePlainTextEmphasis
'''        Debug.Print "AutoFormatReplaceQuotes: "; .AutoFormatReplaceQuotes
'''        Debug.Print "AutoFormatReplaceSymbols: "; .AutoFormatReplaceSymbols
'''    End With

    Debug.Print "Finished! - time taken was: " & (Timer - StartTime) & " seconds"
End Sub

Answer 2

The code below will apply superscript to any of the ordinal suffixes (st, nd, rd, th)

Public Sub MakeOrdinalSuffixesSuperscript()
' makes any of st, nd, rd, th superscripted text when preceded by a
' number and followed by a character not a number or letter

' find a (single number) followed by (two lowercaseletters) from the above
' followed by a (character that is not a letter or a number)
Const FIND_TEXT                               As String = "([0-9])([dhnrst]{2,2})([!0-9a-zA-Z])"
Dim mySearchRange                             As Word.Range

    ' there are a number of ways in which the document content can be selected
    ' this version I feel is best as it is explicit about which text story
    ' in which it is searching
    Set mySearchRange = ActiveDocument.StoryRanges(wdMainTextStory)

    With mySearchRange

        ' Set up the find object
        ' when used with a range the find object will remember the previous settings
        ' so if there is no change in what we search for the execute method
        ' can be called repeatedly without resetting all the find object parameters
        With .Find

            .ClearFormatting
            .Text = FIND_TEXT
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
            .Format = False

        End With

        Do While .Find.Execute
            ' mySearchRange is now the found text so all of the dot notations refer
            ' to mySearchRange

            ' if we didn't want to interfere with the search range we would dim a
            ' new search range variable and make a copy of the search range using
            ' the .duplicate method.

            ' Shrink the range to the two ordinal suffix characters, note the -1 for moveend
            .MoveStart unit:=wdCharacter, Count:=1
            .MoveEnd unit:=wdCharacter, Count:=-1

            ' apply superscript to the oridinal suffix characters
            .Font.Superscript = True

            ' reset the range to include the text from after mySearchRange to
            ' the end of the document
            .MoveStart unit:=wdCharacter, Count:=.Characters.Count + 1
            .End = ActiveDocument.StoryRanges(wdMainTextStory).End

        Loop

    End With

    Beep

End Sub