Sub Pluralise()
' Paul Beverley - Version 15.07.22
' Tries to make the current word plural

Selection.Expand wdWord
Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
  Selection.MoveEnd , -1
  DoEvents
Loop
MyWord = Selection
Selection.Collapse wdCollapseEnd

Select Case Right(MyWord, 2)
  Case "ch":
    Selection.TypeText Text:="es"
  Case "sh":
    Selection.TypeText Text:="es"
  Case "oo":
    Selection.TypeText Text:="s"
  Case "eo":
    Selection.TypeText Text:="s"
  Case "ey":
    Selection.MoveStart , -2
    Selection.TypeText Text:="ies"
  Case Else
    Select Case Right(MyWord, 1)
      Case "o":
        Selection.TypeText Text:="es"
      Case "y":
        Selection.MoveStart , -1
        Selection.TypeText Text:="ies"
      Case "s":
        Selection.TypeText Text:="es"
      Case Else
        Selection.TypeText Text:="s"
    End Select
End Select
End Sub