Sub HyphenSpaceWordCount()
' Paul Beverley - Version 13.05.24
' Counts hyphenated word forms

numChars = Len(Selection.Text)
If Selection.Start = Selection.End Then
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  tx = Selection.Text
  For i = 2 To Len(tx) - 2
    wd1 = Left(tx, i)
    wd2 = Mid(tx, i + 1)
    myPair = tx
    If Application.CheckSpelling(wd1) And _
         Application.CheckSpelling(wd2) Then
      myPair = wd1 & " " & wd2
      Exit For
    End If
  Next i
  myPair = InputBox("OK? (Add a space if necessary)", "HyphenSpaceWordCount", myPair)
  If InStr(myPair, " ") = 0 Then Beep: Exit Sub
Else
  Set rng = Selection.Range.Duplicate
  rng.Collapse wdCollapseEnd
  rng.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(rng.Text, 1)) > 0
    rng.MoveEnd , -1
    DoEvents
  Loop
  Selection.Collapse wdCollapseStart
  Selection.Expand wdWord
  Selection.Collapse wdCollapseStart
  rng.Start = Selection.Start
  rng.Select
  myPair = Selection
End If
Debug.Print myPair
brkPos = InStr(myPair, " ")
If brkPos = 0 Then brkPos = InStr(myPair, "-")
If brkPos = 0 Then brkPos = InStr(myPair, ChrW(8211))
If brkPos = 0 Then brkPos = InStr(myPair, "/")
If brkPos = 0 Then
  Beep
  myResponse = MsgBox("Can't work out where the spilt is, sorry.", vbOKOnly, _
       "HyphenSpaceWordCount")
  Exit Sub
End If

wd1 = LCase(Left(myPair, brkPos - 1))
wd2 = LCase(Mid(myPair, brkPos + 1))

Set rng = ActiveDocument.Content
allText = LCase(rng.Text)

myTot = Len(allText)

p = wd1 & " " & wd2
spaceCount = Len(Replace(allText, p, p & "!")) - myTot

p = wd1 & "-" & wd2
hyphenCount = Len(Replace(allText, p, p & "!")) - myTot

p = wd1 & ChrW(8211) & wd2
dashCount = Len(Replace(allText, p, p & "!")) - myTot

p = wd1 & "/" & wd2
slashCount = Len(Replace(allText, p, p & "!")) - myTot

p = wd1 & wd2
oneWordCount = Len(Replace(allText, p, p & "!")) - myTot

myResult = wd1 & wd2 & ":   " & Str(oneWordCount) & vbCr
myResult = myResult & wd1 & " " & wd2 & ":   " & _
     Str(spaceCount) & vbCr
myResult = myResult & wd1 & "-" & wd2 & ":   " & Str(hyphenCount) _
     & vbCr & vbCr
myResult = myResult & wd1 & "<dash>" & wd2 & ":   " & _
     Str(dashCount) & vbCr
myResult = myResult & wd1 & "/" & wd2 & ":   " & Str(slashCount)

' Load WC find box
mySch = Left(wd1, Len(wd1) - 1) & "[" & Right(wd1, 1) & _
     "^32/\-" & ChrW(8211) & Left(wd2, 1) & "]{2,3}" & Mid(wd2, 2)
myInit = Left(mySch, 1)
mySch = "[" & LCase(myInit) & UCase(myInit) & "]" & Mid(mySch, 2)
Selection.Collapse wdCollapseStart
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = mySch
  .Wrap = wdFindContinue
  .Forward = True
  .Replacement.Text = ""
  .MatchWildcards = True
  .Execute
  DoEvents
End With

MsgBox myResult, 0, "HyphenSpaceWordCount"
End Sub