Sub SelectionStartExtend()
' Paul Beverley - Version 03.07.23
' Moves the start of the selection further out to the left (i.e. extends it)

If Selection.Start = Selection.End Then
  Selection.Expand wdWord
  lenNow = Len(Selection)
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  If Len(Selection) <> lenNow Then Exit Sub
  Set rng = Selection.Range.Duplicate
  rng.Collapse wdCollapseStart
  rng.MoveStart , -1
  preChar = rng.Text
  If (LCase(preChar) = UCase(preChar)) Then Exit Sub
End If

Selection.MoveStart , -1
preChar = Left(Selection, 1)

If LCase(preChar) = UCase(preChar) Then
  If preChar <> "0" And Val(preChar) = 0 Then
    Exit Sub
  End If
End If

Selection.MoveStart , 1
Selection.MoveStart wdWord, -1
End Sub