Sub StickyEmAndEnDashes() ' 03/28/2022
   
    Dim oRange As Range
    Dim strFontSize As String
    Dim strDashtype() As String
    Dim strReplaceString As String
    Dim i As Long
    
    ' Prompt user for body text font size:
    strFontSize = InputBox("Enter the body text font size:")
     ' Exit sub if user cancels:
    If strFontSize = vbNullString Then
        Exit Sub
    End If
    
    Set oRange = ActiveDocument.Range
    
    ' Populate an array with em- and en-dash wildcards:
    strDashtype = Split("^+,^=", ",")
        
    For i = LBound(strDashtype) To UBound(strDashtype)
    
        ' Concatenate a replace string variable, as it's not possible to
        ' mix strings and variables for the replacement string:
        strReplaceString = "^s" & strDashtype(i) & "^s"
        
        With oRange.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            ' Find all em or en dashes:
            .Text = strDashtype(i)
            
            ' Replace with nonbreak-em/en-dash-nonbreak, 1-pt font:
            .Replacement.Text = strReplaceString
            .Replacement.Font.Size = 1
            .Execute Replace:=wdReplaceAll
            
            ' Find all em/en dashes again:
            .Text = strDashtype(i)
            .Replacement.Text = strDashtype(i)
            ' Replace with the normal font size:
            .Replacement.Font.Size = strFontSize
            .Execute Replace:=wdReplaceAll
        End With
    Next i
    
    ' Clean up:
    With oRange.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = False
    End With
    
    Set oRange = Nothing
    
End Sub