Function CountRevisions(Rng As Range) As Long
Dim i As Long, j As Long, Str As String
With Rng
  For i = 1 To .Revisions.Count
    If .Revisions(i).Type = wdRevisionInsert Then
      j = j + .Revisions(i).Range.ComputeStatistics(wdStatisticWords)
    ElseIf .Revisions(i).Type = wdRevisionDelete Then
      Str = Trim(.Revisions(i).Range.Text)
      Str = Replace(Str, vbCr, " ")
      While InStr(Str, "  ") > 0
        Str = Replace(Str, "  ", " ")
      Wend
      j = j - (UBound(Split(Str, " ")) + 1)
    End If
  Next
End With
CountRevisions = j
End Function