Sub MerriamFetch()
' Paul Beverley - Version 26.03.25
' Launches selected text to Merriam

mySite = "https://www.merriam-webster.com/dictionary/"

If Selection.start = Selection.End Then
  Selection.Expand wdWord
  If Len(Selection) < 2 Then
    Selection.Collapse wdCollapseStart
    Selection.MoveLeft , 1
    Selection.Expand wdWord
  End If
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  Set rng = Selection.Range.Duplicate
  rng.MoveStart , -1
  If Left(rng, 1) = "-" Then
    Selection.MoveStart wdWord, -2
  End If
  rng.MoveEnd , 1
  If Right(rng, 1) = "-" Then
    Selection.MoveEnd wdWord, 2
  End If
Else
  endNow = Selection.End
  Selection.MoveLeft wdWord, 1
  startNow = Selection.start
  Selection.End = endNow
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  Selection.start = startNow
End If
mySubject = Trim(Selection)
mySubject = Replace(mySubject, " ", "+")
mySubject = Replace(mySubject, "&", "%26")
mySubject = Replace(mySubject, ChrW(8217), "'")
ActiveDocument.FollowHyperlink Address:=mySite & mySubject
Selection.Collapse wdCollapseEnd
End Sub