Sub Colon()
' Paul Beverley - Version 23.01.23
' Makes adjacent words into colon separated

uppercaseAfter = False

newBit = ": "
myQuotes = Chr(34) & Chr(39) & ChrW(8220) & ChrW(8216)
Selection.Collapse wdCollapseEnd
While (LCase(Selection) <> UCase(Selection))
  Selection.MoveRight 1
  DoEvents
Wend
myStart = Selection.Start
If Selection = ChrW(8217) Then myStart = myStart + 1
Do
  Selection.MoveRight 1
  DoEvents
  If Selection.Start = ActiveDocument.Content.End - 1 _
     Then Beep: Exit Sub
Loop Until LCase(Selection) <> UCase(Selection) Or Asc(Selection) = 1
myEnd = Selection.Start
Set rng = ActiveDocument.Content
rng.End = myEnd
rng.Start = myStart
wasMiddle = rng
lastChar = Right(rng, 1)

If uppercaseAfter = False Then
  If LCase(Selection) <> Selection Then
  ' It needs lowercasing
    Selection.Start = Selection.Start - 1
    preChar = Selection
    Selection.MoveStart 1
    Selection.MoveEnd 1
    newLetter = LCase(Selection)
    If InStr(myQuotes, preChar) > 0 Then
      Selection.Delete
      Selection.TypeText newLetter
      Selection.End = myEnd - 1
    Else
      newBit = newBit & newLetter
    End If
    Selection.Start = myStart
  Else
    If lastChar = " " And Len(rng) > 1 Then newBit = Trim(newBit)
    Selection.MoveLeft 1
  End If
Else
  If UCase(Selection) <> Selection Then
  ' It needs uppercasing
    Selection.Start = Selection.Start - 1
    preChar = Selection
    Selection.MoveStart 1
    Selection.MoveEnd 1
    newLetter = UCase(Selection)
    If InStr(myQuotes, preChar) > 0 Then
      Selection.Delete
      Selection.TypeText newLetter
      Selection.End = myEnd - 1
    Else
      newBit = newBit & newLetter
    End If
    Selection.Start = myStart
  Else
    If lastChar = " " And Len(rng) > 1 Then newBit = Trim(newBit)
    Selection.MoveLeft 1
  End If
End If
Selection.Start = myStart
Selection.Delete
Selection.TypeText newBit
Selection.MoveRight count:=1
End Sub