Word VBA Find Passive Voice

Question

I have written a procedure to find passive constructions, e.g. 'was solved', 'been written', i.e. passives ending in 'ed' or 'en', but not things like 'was fruitful'. A comment is inserted for each find. I'm almost there - but cannot fix a couple of anomalies: It works for 'was solved.' , 'was solved .' and 'was solved ', (NB spaces in two of these) but not in 'was solved today', i.e. where there are more words after the final verb. This last error is the one I wish to fix. It also finds the passives in 'is being completed', i.e. two auxiliary verbs together, whether spaces follow the final verb or not. This is an added bonus, apart from the fact that the find is indicated twice. I suspect this is to do with my Is_Alpha function, which strips punctuation from the end of the main verb. Thanks folks, any help appreciated.

Sub Passives3()
Dim P_Flag As Boolean
Dim P_Cmt As Comment
Dim P_Rng As Range
Dim P_Rng2 As String
Dim P_New As String
Dim P_Fnd As Boolean
Dim Cmt As Comment
Dim P_Range As Range
Dim P_Ctr As Long
Dim Com_plete As Integer
Dim P_Word(7) As String
    P_Word(0) = "am "
    P_Word(1) = "are "
    P_Word(2) = "be "
    P_Word(3) = "been "
    P_Word(4) = "being "
    P_Word(5) = "is "
    P_Word(6) = "was "
    P_Word(7) = "were "
For P_Ctr = LBound(P_Word) To UBound(P_Word)
Set P_Rng = ActiveDocument.Range
    With P_Rng.Find
        .ClearFormatting
        .text = P_Word(P_Ctr)
        Debug.Print .text
        .MatchCase = False
        .MatchWholeWord = True
        While .Execute
            If P_Rng.Find.Found Then
                Dim P_test As Range
                Set P_test = P_Rng.Duplicate
                With P_test
                   .MoveEnd wdWord, 2
                   .Select
                    P_New = P_test
                    Call Is_Alpha(P_New, P_Flag)
                    If P_Flag = False Then
                        P_New = Left(P_New, Len(P_New) - 1)
                    End If
                End With
                If (Right(Trim(P_New), 2)) = "ed" _
                Or (Right(Trim(P_New), 2)) = "en" Then
                    Set P_Cmt = P_Rng.Comments.Add(Range:=P_Rng, text:="Passive? " & P_New)
                    P_Cmt.Author = "Passives"
                    P_Cmt.Initial = "PSV "
                    P_Cmt.Range.Font.ColorIndex = wdGreen
                End If
            End If
        Wend
    End With
Next
End Sub

Function Is_Alpha(P_New As String, P_Flag As Boolean) As Boolean
If Asc(Right(P_New, 1)) > 64 And Asc(Right(P_New, 1)) < 90 Or _
       Asc(Right(P_New, 1)) > 96 And Asc(Right(P_New, 1)) < 123 Then
       P_Flag = True
       Else
       P_Flag = False
End If
End Function

Please give a full [mcve] including input/output data and what output you desire. Also you might consider using Regular Expressions. — Pᴇʜ, Feb 23 '21 at 10:55
I would also go with regular expressions -- see [here](https://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops). Even though the question talks a lot about Excel, almost everything applies equally well to using the VBScript regex library from Word. — Zev Spitz, Feb 23 '21 at 12:13

score 1 · Answer 1 · answered Feb 23 '21 at 11:40

How about:

Sub Passives()
Dim i As Long, j As Long, Cmt As Comment, P_Words, X_Words
P_Words = Array("am ", "are ", "be ", "been ", "being ", "is ", "was ", "were ")
X_Words = Array("am ", "are ", "being ", "is ", "was ", "were ", "has ", "have ")
For i = LBound(P_Words) To UBound(P_Words)
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Text = "<" & P_Words(i) & "[! ]@e[dn]>"
      .MatchWildcards = True
    End With
    Do While .Find.Execute
      For j = LBound(X_Words) To UBound(X_Words)
        If .Words.First.Previous.Words.First.Text = X_Words(j) Then
          .Start = .Words.First.Previous.Words.First.Start
        End If
      Next
      Set Cmt = .Comments.Add(Range:=.Duplicate, Text:="Passive?")
      With Cmt
        .Author = "Passives"
        .Initial = "PSV "
        .Range.Font.ColorIndex = wdGreen
      End With
      .Collapse wdCollapseEnd
    Loop
  End With
Next
End Sub

Many thanks works great - but could you explain how the .text wildcards line works? — hmm, Feb 23 '21 at 12:57
The < designates the beginning of a word and the > designates the end of a word. The [! ]@ designates any series of characters other than a space. The [dn] designates either d or n. Hence, P_Words(i) must occur at the start of a word, and the next word must end in ed or en. For more, see: https://wordmvp.com/FAQs/General/UsingWildcards.htm — macropod, Feb 23 '21 at 21:53

Word VBA Find Passive Voice

1 Answers1