Some of the characters don't show right in default view, click download or raw to get everything

TypographicalReplace.bas

Sub CurlyQs()
'
' CurlyQs Macro
' Macro first recorded Thursday, September 11, 2003 by Mark L Ward Jr
' Refactored with regex by Duncan Johnson Sept 17, 2010
' 
' Makes assorted typographical corrections

    FindReplace "  "," " 'double spaces with a single space
    FindReplace """","""" 'straight double quote with smart quote (assumes Smart Quotes are enabled in Word settings)
    FindReplace "'","'" 'straight single quote with smart quote (assumes Smart Quotes are enabled in Word settings)
    FindReplace "--","—" 'double hyphen with em dash
    FindReplace " — ","—" 'em dash with two spaces to no spaces
    FindReplace " —","—" 'em dash with space before to no spaces
    FindReplace "— ","—" 'em dash with space after to no spaces
    FindReplace "([0-9])-([0-9])","\1–\2",True 'hyphens between numerals into en dashes
    FindReplace "Saviour","Savior" 'Saviour > Savior

    FindReplace "…’","…‘" ' fix apostrophe next to ellipsis
    FindReplace "—”","—“" ' fix quote next to dash
    
    'Substitute nonbreaking space between numeral and bookname of biblical books such as 1 Sam
    FindReplace "([1-2]) Sam","\1^0160Sam",True
    FindReplace "([1-2]) Kgs","\1^0160Kgs",True
    FindReplace "([1-2]) Kings","\1^0160Kings",True
    FindReplace "([1-2]) Cor","\1^0160Cor",True
    FindReplace "([1-2]) Thess","\1^0160Thess",True
    FindReplace "([1-2]) Tim","\1^0160Tim",True
    FindReplace "([1-2]) Pet","\1^0160Pet",True
    FindReplace "([1-3]) John","\1^0160John",True
    FindReplace "([1-4]) Macc","\1^0160Macc",True

    'ActiveDocument.StoryRanges(wdMainTextStory) = RegExpReplace(ActiveDocument.StoryRanges(wdMainTextStory), "(1|2|3|4) ((?:Sam)|(?:Kgs)|(?:Kings)|(?:Chr)|(?:Cor)|(?:Thes)|(?:Tim)|(?:Pet)|(?:John)|(?:Macc))", "$1" & Chr(160) & "$2")
    
    'If ActiveDocument.Footnotes.Count >= 1 Then 'do for footnotes
      'ActiveDocument.StoryRanges(wdFootnotesStory) = RegExpReplace(ActiveDocument.StoryRanges(wdFootnotesStory), "(1|2|3|4) ((?:Sam)|(?:Kgs)|(?:Kings)|(?:Chr)|(?:Cor)|(?:Thes)|(?:Tim)|(?:Pet)|(?:John)|(?:Macc))", "$1" & Chr(160) & "$2")
    'End If
End Sub

Private Sub FindReplace(findStr as String, repStr as String, Optional MatchWildCards as Boolean = False)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Text = findStr
    Selection.Find.Replacement.Text = repStr
    Selection.Find.Forward = True
    Selection.Find.Wrap = wdFindContinue
    Selection.Find.MatchWildcards = MatchWildCards
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Private Function RegExpReplace(LookIn As String, PatternStr As String, Optional ReplaceWith As String = "", _
    Optional ReplaceAll As Boolean = True, Optional MatchCase As Boolean = True)
     
     ' This function uses Regular Expressions to parse a string, and replace parts of the string
     ' matching the specified pattern with another string.  The optional argument ReplaceAll controls
     ' whether all instances of the matched string are replaced (True) or just the first instance (False)
     
     ' By default, RegExp is case-sensitive in pattern-matching.  To keep this, omit MatchCase or
     ' set it to True
     
     ' If you use this function from Excel, you may substitute range references for all the arguments
     
    Dim RegX As Object
     
    Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = PatternStr
        .Global = ReplaceAll
        .IgnoreCase = Not MatchCase
    End With
     
    RegExpReplace = RegX.Replace(LookIn, ReplaceWith)
     
    Set RegX = Nothing
     
End Function