Sub MarkWardsMicrosoftWordMiracleMacro() ' ' First recorded Thursday, September 11, 2003 by Mark Lee Ward, Jr. ' Latest version: April 7, 2011 ' This macro is for turning straight quotes into smart quotes, ' double hyphens (--) into em dashes, ' two concurrent spaces into one space, ' em dashes with spaces around them to em dashes with no spaces, ' hyphens between numerals (as in Scripture references) into en dashes, ' and for adding nonbreaking spaces to Scripture references such as 1 Sam. ' It also fixes the direction of curly quotation marks which are adjacent to ' other punctuation marks like dashes and ellipses. ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = """" .Replacement.Text = """" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "'" .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "--" .Replacement.Text = "—" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = " — " .Replacement.Text = "—" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = " —" .Replacement.Text = "—" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "([0-9])-([0-9])" .Replacement.Text = "\1–\2" .Forward = True .Wrap = wdFindContinue .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "— " .Replacement.Text = "—" .Forward = True .Wrap = wdFindContinue .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "…’" .Replacement.Text = "…‘" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "—”" .Replacement.Text = "—“" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "—’" .Replacement.Text = "—‘" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "’“" .Replacement.Text = "’”" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "/”" .Replacement.Text = "/“" .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Gen " .Replacement.Text = "Gen^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Exod " .Replacement.Text = "Exod^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Lev " .Replacement.Text = "Lev^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Num " .Replacement.Text = "Num^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Deut " .Replacement.Text = "Deut^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Josh " .Replacement.Text = "Josh^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Judg " .Replacement.Text = "Judg^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ruth " .Replacement.Text = "Ruth^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Sam " .Replacement.Text = "1^0160Sam^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Sam " .Replacement.Text = "2^0160Sam^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Kgs " .Replacement.Text = "1^0160Kgs^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Kgs " .Replacement.Text = "2^0160Kgs^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Chr " .Replacement.Text = "1^0160Chr^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Chr " .Replacement.Text = "2^0160Chr^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ezra " .Replacement.Text = "Ezra^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Neh " .Replacement.Text = "Neh^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Esth " .Replacement.Text = "Esth^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Job " .Replacement.Text = "Job^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ps " .Replacement.Text = "Ps^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Prov " .Replacement.Text = "Prov^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Eccl " .Replacement.Text = "Eccl^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Song " .Replacement.Text = "Song^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Isa " .Replacement.Text = "Isa^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Jer " .Replacement.Text = "Jer^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Lam " .Replacement.Text = "Lam^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ezek " .Replacement.Text = "Ezek^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Dan " .Replacement.Text = "Dan^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Hos " .Replacement.Text = "Hos^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Joel " .Replacement.Text = "Joel^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Amos " .Replacement.Text = "Amos^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Obad " .Replacement.Text = "Obad^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Jonah " .Replacement.Text = "Jonah^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Mic " .Replacement.Text = "Mic^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Nah " .Replacement.Text = "Nah^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Hab " .Replacement.Text = "Hab^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Zeph " .Replacement.Text = "Zeph^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Hag " .Replacement.Text = "Hag^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Zech " .Replacement.Text = "Zech^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Mal " .Replacement.Text = "Mal^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Matt " .Replacement.Text = "Matt^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Mark " .Replacement.Text = "Mark^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Luke " .Replacement.Text = "Luke^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "John " .Replacement.Text = "John^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Acts " .Replacement.Text = "Acts^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Rom " .Replacement.Text = "Rom^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Cor " .Replacement.Text = "1^0160Cor^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Cor " .Replacement.Text = "2^0160Cor^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Gal " .Replacement.Text = "Gal^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Eph " .Replacement.Text = "Eph^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Phil " .Replacement.Text = "Phil^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Col " .Replacement.Text = "Col^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Thess " .Replacement.Text = "1^0160Thess^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Thess " .Replacement.Text = "2^0160Thess^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Tim " .Replacement.Text = "1^0160Tim^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Tim " .Replacement.Text = "2^0160Tim^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Titus " .Replacement.Text = "Titus^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Phlm " .Replacement.Text = "Phlm^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Heb " .Replacement.Text = "Heb^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Jas " .Replacement.Text = "Jas^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 Pet " .Replacement.Text = "1^0160Pet^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 Pet " .Replacement.Text = "2^0160Pet^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "1 John " .Replacement.Text = "1^0160John^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "2 John " .Replacement.Text = "2^0160John^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "3 John " .Replacement.Text = "3^0160John^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Jude " .Replacement.Text = "Jude^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Rev " .Replacement.Text = "Rev^0160" .Forward = True .Wrap = wdFindContinue .MatchCase = True .MatchWholeWord = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "~**~" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .MatchCase = False .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub