Sub SurnamesInitialCapital()
' Paul Beverley - Version 18.09.15
' Initial capital all the surnames in a refs list

minLength = 2
' Use minLength = 3 if initials are unspaced and have no full ponts
' e.g. BEVERLEY, PE 2003

paraNum = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
apos = "'" & ChrW(8217)
For para = paraNum To ActiveDocument.Paragraphs.Count
  Set p = ActiveDocument.Paragraphs(para).Range
  testBit = Left(p.Text, 10)
  If Len(p.Text) < 4 Then
    p.Select
    Selection.Collapse wdCollapseEnd
    Beep
    Exit Sub
  End If
  If Len(p.Text) > 3 And InStr(testBit, "(") = 0 Then
    isAcronym = True
    For i = 2 To p.Words.Count
      w = p.Words(i).Text
      isAlpha = (UCase(w) <> LCase(w))
      If Len(Trim(w)) = 1 And isAlpha Then isAcronym = False
      If Val(w) > 100 Then Exit For
      If Len(w) >= minLength And UCase(w) = w And isAlpha Then
        p.Words(i).Case = wdLowerCase
        If p.Words(i) <> "and " Then p.Words(i).Characters(1).Case = wdUpperCase
        p.Words(i).Characters(1).Select
        If InStr(apos, p.Words(i).Characters(2)) > 0 Then
          p.Words(i).Characters(3).Case = wdUpperCase
        End If
      End If
    Next i
    If isAcronym = False Then
      w = p.Words(1).Text
      p.Words(1).Case = wdLowerCase
      p.Words(1).Characters(1).Case = wdUpperCase
      p.Words(1).Characters(1).Select
      If InStr(apos, p.Words(1).Characters(2)) > 0 Then
        p.Words(1).Characters(3).Case = wdUpperCase
      End If
    End If
    
    inPos = InStr(p.Text, "In:")
    If inPos > 0 Then
      p.Select
      Selection.MoveStart , inPos + 3
      For i = 1 To Selection.Words.Count
        w = Selection.Words(i).Text
        If w = "(" Then Exit For
        If Len(w) > 1 And UCase(w) = w And UCase(w) <> LCase(w) Then
          Selection.Words(i).Case = wdLowerCase
          Selection.Words(i).Characters(1).Case = wdUpperCase
          If InStr(apos, Selection.Words(i).Characters(2)) > 0 Then
            Selection.Words(i).Characters(3).Case = wdUpperCase
          End If
        End If
      Next i
    End If
  End If
Next para
Selection.Collapse wdCollapseEnd
End Sub