Sub AutoSpellCorrect()
Dim oDic As Object
Dim oRng As Range, oSuggestions As Variant
Dim arrJoined() As String, arrSplit() As String
Dim lngIndex As Long
  'Here I have defined a short list of Joined/Split word pairs. You could also use an exteranl list e.g., Excel or word table.
  arrJoined = Split("currentedition|happyending|towncounsel", "|")
  arrSplit = Split("current edition|happy ending|town counsel", "|")
  Set oDic = CreateObject("Scripting.Dictionary")
  For lngIndex = 0 To UBound(arrJoined)
    oDic.Add arrJoined(lngIndex), arrSplit(lngIndex)
  Next lngIndex
  For Each oRng In ActiveDocument.Range.SpellingErrors
    With oRng
      If oDic.Exists(oRng.Text) Then
        oRng.Text = oDic(oRng.Text)
      Else
        oRng.Select
        If .GetSpellingSuggestions.Count > 0 Then
          Set oSuggestions = .GetSpellingSuggestions
          oRng.Text = InputBox("Replace this spelling error with ... ", "REPLACEMENT", oSuggestions(1))
        Else
          oRng.Text = InputBox("Replace this spelling error with ... ", "REPLACEMENT", oRng.Text)
        End If
      End If
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub