Sub PDFspellIgnoreProperNouns()
' Paul Beverley - Version 17.11.22
' Underlines all spelling errors except proper nouns

' Highlight the result (use zero or wdNoHighlight for no highlight)
myColour = wdYellow
' myColour = wdNoHighlight

Selection.HomeKey Unit:=wdStory
langText = Languages(Selection.LanguageID).NameLocal
wasIgnore = Options.IgnoreMixedDigits
Options.IgnoreMixedDigits = False
allAlphas = ""
For j = 192 To 255
  If j <> 215 And j <> 247 Then allAlphas = allAlphas & ChrW(j)
Next j
For j = 65 To 90
  allAlphas = allAlphas & ChrW(j)
Next j
For j = 97 To 122
  allAlphas = allAlphas & ChrW(j)
Next j

j = ActiveDocument.Words.count
Set rng = ActiveDocument.Content

For Each wd In ActiveDocument.Words
  If Len(wd) > 2 Then
    Do While InStr(ChrW(8217) & "'", Right(wd.Text, 1)) > 0
      wd.MoveEnd , -1
      DoEvents
    Loop
    If Right(wd, 2) = ChrW(8217) & "s" Then wd.MoveEnd , -2
    If Right(wd, 2) = "'s" Then wd.MoveEnd , -2
    
    If wd.Font.StrikeThrough = False Then
      If Application.CheckSpelling(wd, MainDictionary:=langText) = False Then
        w = Trim(wd.Text)
        cap = Left(w, 1)
        isApropernoun = (LCase(cap) <> cap)
      ' but if it contains numbers, it's not a proper noun
        For k = 1 To Len(w)
          If Asc(Mid(w, k, 1)) < 65 Then isApropernoun = False: Exit For
        Next k
      ' Check the previous character
        rng.Start = wd.Start - 1
        rng.End = wd.Start
        If rng > "" Then
          If Asc(rng) = 13 Or Asc(rng) = 9 Then isApropernoun = False
          If Left(rng, 1) = "(" Then rng.MoveStart , -1
          rng.MoveStart , -1
          If InStr(allAlphas & ";:,", Left(rng, 1)) = 0 Then _
               isApropernoun = False
        End If
        If isApropernoun = False Then
          wd.Font.Underline = True
          wd.HighlightColorIndex = wdYellow
        End If
      End If
    End If
    j = j - 1
    If j Mod 100 = 0 Then
      StatusBar = "Spellchecking. To go: " & Str(j)
      DoEvents
    End If
  End If
Next wd
StatusBar = ""
Options.IgnoreMixedDigits = wasIgnore
End Sub