Sub FullPoint()
' Paul Beverley - Version 21.01.26
' Makes adjacent words into sentence break

newPunc = ". "
nextWordCapital = True

myQuotes = Chr(34) & Chr(39) & ChrW(8220) & ChrW(8216)
oldBits = ";:.,!?-" & ChrW(8212) & ChrW(8211)

Set rng = Selection.Range.Duplicate
rng.MoveEnd , 50
For i = 1 To rng.Characters.Count
  If InStr(oldBits, rng.Characters(i)) > 0 Then Exit For
Next i
If i > 50 Then
  Beep
  MsgBox "No relevant punctuation found."
  Exit Sub
End If

moveBack = (rng.Characters(i - 1) = " ")
rng.MoveStart , i - 1
If moveBack = True Then rng.MoveStart , -1
rng.Select
rng.Collapse wdCollapseStart

Do
  rng.MoveEnd , 1
  lastChar = rng.Characters.Last
  DoEvents
Loop Until UCase(lastChar) <> LCase(lastChar)

If nextWordCapital = True Then
  rng.Characters.Last = UCase(lastChar)
Else
  rng.Characters.Last = LCase(lastChar)
End If
lastChar = rng.Characters.Last
If InStr(myQuotes, lastChar) Then rng.MoveEnd , -1
rng.Text = newPunc
rng.Collapse wdCollapseEnd
rng.Select
End Sub