VBA Macro doesn't work if the selection is only have 1 instance of the searched character

Question

I am writing a macro that turns selected asterisk characters into superscripted asterisk. Selection is important since I don't want to mess up my document completely. Here is the code:

Sub Superstarv4()
' makes all selected asterisks superscripted
    Dim selRange As Range

    ' Check if text is selected
    If Selection.Type = wdSelectionIP Then
        MsgBox "No text selected. Please select some text.", vbExclamation
        Exit Sub
    End If

    ' Set selRange to the selected range
    Set selRange = Selection.Range

    ' Apply formatting only to the selected range
    With selRange.Find
        .ClearFormatting
        .Text = "*"  ' Find asterisks
        .Replacement.ClearFormatting
        .Replacement.Font.Superscript = True  ' Format as superscript
        .Execute Replace:=wdReplaceAll
    End With
End Sub

This worked mostly. I aimed to turn the whole process into a button press. But there is a catch. This code works wrong if I were to select one (1) asterisk character, it converts ALL of the following asterisk character superscripted in the whole document. This problem consists of all VBA replacement operations. I got a similar code that turns commas into dots with the same problem.

There is a quick fix to the problem which goes like this:

Sub Superstarv5()
    ' Check if text is selected
    If Selection.Type = wdSelectionIP Then
        MsgBox "No text selected. Please select some text.", vbExclamation
        Exit Sub
    End If

    Dim selRange As Range
    Set selRange = Selection.Range

    ' Ensure the range is valid and has text
    If selRange.Text = "" Then
        MsgBox "Selected text is empty. Please select some text.", vbExclamation
        Exit Sub
    End If

    ' Count the number of asterisks in the selected text
    Dim asteriskCount As Long
    asteriskCount = Len(selRange.Text) - Len(Replace(selRange.Text, "*", ""))

    ' Check if there is more than one asterisk
    If asteriskCount <= 1 Then
        MsgBox "Selected text does not contain more than one asterisk. No formatting applied.", vbInformation
        Exit Sub
    End If

    ' Apply superscript formatting only to the selected range
    With selRange.Find
        .ClearFormatting
        .Text = "*"  ' Find asterisks
        .Replacement.ClearFormatting
        .Replacement.Font.Superscript = True  ' Format as superscript
        .Execute Replace:=wdReplaceAll
    End With
End Sub

This first makes sure the user selected two instances of asterisks. But I don't want a work around or a quick fix. Is there anything I am doing wrong or is this a known (or unknown) bug in MSWord?

Answer 1

The main issue in your original code is that the Find operation affects the entire document when only one asterisk is selected. By adding .Wrap = wdFindStop, the search is limited to the selected range only, preventing changes outside the selection. This ensures the macro superscripts only the selected asterisks, no matter how many are present.

Here's the adjusted key part:

.Wrap = wdFindStop ' Stop at the end of the selection

Sub SuperstarFixed()
    Dim SelRange As Range
    Dim n As Long
    Dim CharRange As Range

    Rem Check if text is selected
    If Selection.Type = wdSelectionIP Then
        MsgBox "No text selected. Please select some text.", vbExclamation
        Exit Sub
    End If

    Rem Set selRange to the selected range
    Set SelRange = Selection.Range

    Rem Loop through each character in the selection
    For n = 1 To SelRange.Characters.Count
        Rem Set charRange to each individual character
        Set CharRange = SelRange.Characters(n)

        Rem Check if the character is an asterisk
        If CharRange.Text = "*" Then
            Rem Apply superscript formatting
            CharRange.Font.Superscript = True
        End If
    Next
End Sub