Highlight (not delete) repeat sentences or phrases

Question

I am getting the impression that this is not possible in word but I figure if you are looking for any 3-4 words that come in the same sequence anywhere in a very long paper

Answer 1

I chose a rather lame theory, but it seems to work (at least if I got the question right cuz sometimes I'm a slow understander). I load the entire text into a string, load the individual words into an array, loop through the array and concatenate the string, containing each time three consecutive words.
Because the results are already included in 3 word groups, 4 word groups or more will automatically be recognized.

Option Explicit

Sub Find_Duplicates()

On Error GoTo errHandler

Dim pSingleLine                     As Paragraph
Dim sLine                           As String
Dim sFull_Text                      As String
Dim vArray_Full_Text                As Variant

Dim sSearch_3                       As String
Dim lSize_Array                     As Long
Dim lCnt                            As Long
Dim lCnt_Occurence                  As Long


'Create a string from the entire text
For Each pSingleLine In ActiveDocument.Paragraphs
    sLine = pSingleLine.Range.Text
    sFull_Text = sFull_Text & sLine
Next pSingleLine

'Load the text into an array
vArray_Full_Text = sFull_Text
vArray_Full_Text = Split(sFull_Text, " ")
lSize_Array = UBound(vArray_Full_Text)


For lCnt = 1 To lSize_Array - 1
    lCnt_Occurence = 0
    sSearch_3 = Trim(fRemove_Punctuation(vArray_Full_Text(lCnt - 1) & _
                    " " & vArray_Full_Text(lCnt) & _
                    " " & vArray_Full_Text(lCnt + 1)))

    With Selection.Find
        .Text = sSearch_3
        .Forward = True
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False

        Do While .Execute

            lCnt_Occurence = lCnt_Occurence + 1
            If lCnt_Occurence > 1 Then
                Selection.Range.Font.Color = vbRed
            End If
            Selection.MoveRight
        Loop
    End With

    Application.StatusBar = lCnt & "/" & lSize_Array
Next lCnt

errHandler:
Stop

End Sub

Public Function fRemove_Punctuation(sString As String) As String

Dim vArray(0 To 8)      As String
Dim lCnt                As Long


vArray(0) = "."
vArray(1) = ","
vArray(2) = ","
vArray(3) = "?"
vArray(4) = "!"
vArray(5) = ";"
vArray(6) = ":"
vArray(7) = "("
vArray(8) = ")"

For lCnt = 0 To UBound(vArray)
    If Left(sString, 1) = vArray(lCnt) Then
        sString = Right(sString, Len(sString) - 1)
    ElseIf Right(sString, 1) = vArray(lCnt) Then
        sString = Left(sString, Len(sString) - 1)
    End If
Next lCnt

fRemove_Punctuation = sString

End Function

The code assumes a continuous text without bullet points.