Sub CleanUpSpacingEtc()

Dim FindTheText, ReplaceText As String


initbox = MsgBox("This macro applies to the SELECTION or the rest of the document FROM THE POINT OF THE CURSOR." & Chr(10) & Chr(10) & "To run the macro on your whole document, please place the cursor at the start of the document." & Chr(10) & Chr(10) & "Press OK to proceed. Press Cancel to try again.", vbOKCancel, "Warning")

If initbox = vbCancel Then Exit Sub

'Convert nonbreaking spaces to normal spaces
FindTheText = "^s"
ReplaceTheText = " "

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    
    
'Convert "funny" nonbreaking spaces to normal spaces
FindTheText = "^u8239"
ReplaceTheText = " "

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   

'Convert line breaks to paragraph marks
FindTheText = "^l"
ReplaceTheText = "^p"

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
   
   
'Trim trailing white space(s)/tab(s) at the ends of lines
FindTheText = "^w^p"
ReplaceTheText = "^p"

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
   

'Trim white space(s)/tab(s) at the starts of lines
FindTheText = "^p^w"
ReplaceTheText = "^p"

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    
    
'Convert multiple spaces to single spaces
FindTheText = " {2,}"
ReplaceTheText = " "

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    
    
'Convert multiple paragraph returns to single
FindTheText = "^13{2,}"
ReplaceTheText = "^p"

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = FindTheText
        .Replacement.Text = ReplaceTheText
        '.Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
   
   Selection.Find.MatchWildcards = False
   
   
MsgBox "Fixed the following: " & Chr(10) & "• nonbreaking space --> regular space" & Chr(10) & "• funny unicode nonbreaking space (^u8239) --> regular space" & Chr(10) & "• converted line breaks (^l) to paragraph returns (^p)" & Chr(10) & "• trimmed spaces/tabs from the starts and ends of paragraphs" & Chr(10) & "• converted all multiple spaces to a single space" & Chr(10) & "• converted all multiple returns (^p^p etc.) to single"
   
   
End Sub