Welcome to VBAX ResidentCV. I'm not a Word guru but maybe try this

Sub ReduceSpaces()
    Application.ScreenUpdating =False
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text ="^w"
        .Replacement.ClearFormatting
        .Replacement.Text ="  "
        .MatchCase =False
        .MatchWholeWord =False
        .MatchWildcards =False
        .Execute Replace:=wdReplaceAll
    EndWith
    Application.ScreenUpdating =True
End Sub
Note in the line .Replacement.Text = " ", we have two spaces between the quotation marks.

HTH
Aussiebear