Sub EmDash()
Dim rngStory As Range
    For Each rngStory In ActiveDocument.StoryRanges
Dim MyList() As String
Dim i As Long
Options.DefaultHighlightColorIndex = wdTurquoise
MyList = Split("—,[ ]{1,}—[ ]{1,}")
For i = 0 To UBound(MyList())
    Set r = ActiveDocument.Range
        With rngStory.Find
            .Text = MyList(i)
            .Replacement.Text = "^32—^32"
            .MatchWildcards = True
            .MatchCase = True
            .Replacement.Highlight = wdTurquoise
            .Execute Replace:=wdReplaceAll
    End With
    Next
Next
End Sub