Выделить абзац с наибольшим количеством найденных слов

Private Sub CommandButton1_Click()
 
    Dim counter As Integer
    Dim word As String
 
    word = InputBox("Type words: ")
 
    If word = Empty Then Exit Sub
 
    For Each i In ActiveDocument.Paragraphs()
    With Selection.Find
      .Text = word
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .MatchWholeWord = True
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Not Selection.Font.ColorIndex = wdGreen Then
      counter = counter + 1
      Selection.Font.ColorIndex = wdGreen
      Selection.Font.Size = 20
      Selection.Font.Name = "Arial"
      Selection.Font.Bold = True
      Selection.MoveRight Unit:=wdWord, count:=1
    Else
        MsgBox "Quantity of searched words: " & counter & ""
    Exit Sub
    End If
    Next i
End Sub

Private Sub CommandButton1_Click()
    Dim counter&, i&, l&, counters() As Long
    Dim s$, words() As String
    Dim ll&
    s = InputBox("Type words")
    If Len(s) Then Else Exit Sub
    words = Split(s, " ")
    With ActiveDocument
        ll = .Paragraphs.Count
        ReDim counters(1 To ll)
        For i = 1 To ll
            s = .Paragraphs(i).Range
            For Each v In words
                If Len(v) Then
                    l = InStr(1, s, v, vbTextCompare)
                    Do While l
                        l = l + 1
                        counter = counter + 1
                        l = InStr(l, s, v, vbTextCompare)
                    Loop
                    counters(i) = counters(i) + counter
                    counter = 0
                End If
            Next
        Next
        l = 0
        For i = 1 To ll
            If counters(i) > l Then l = counters(i): counter = i
        Next
        .Paragraphs(counter).Range.HighlightColorIndex = wdYellow
        MsgBox "Paragraph No " & counter & vbCrLf & "Finded: " & l
    End With
End Sub

For Each v In words

            For Each m In ActiveDocument.words
                    If LCase(m) = v Then
                        m.Font.ColorIndex = wdRed
                    End If
                Next m

Private Sub CommandButton1_Click()
    Dim counter&, i&, l&, counters() As Long
    Dim s$, words() As String
    Dim ll&
    s = Trim$(InputBox("Type words"))
    If Len(s) Then Else Exit Sub
    words = Split(s, " ")
    With ActiveDocument
        ll = .Paragraphs.Count
        ReDim counters(1 To ll)
        For i = 1 To ll
            For Each v In words
                If Len(v) Then
                    For Each vv In .Paragraphs(i).Range.words
                        If UCase(Trim$(vv)) = UCase(v) Then counter = counter + 1
                    Next
                    counters(i) = counters(i) + counter
                    counter = 0
                End If
            Next
        Next
        For i = 1 To ll
            If counters(i) > l Then l = counters(i): counter = i
        Next
        If counter Then
            For Each v In words
                If Len(v) Then
                    For Each vv In .Paragraphs(counter).Range.words
                        If UCase(Trim$(vv)) = UCase(v) Then vv.HighlightColorIndex = wdBrightGreen
                    Next
                End If
            Next
            s = "Paragraph No " & counter & vbCrLf & "Finded: " & l
        Else
            s = "Find is missed!"
        End If
    End With
    MsgBox s
End Sub

Private Sub CommandButton1_Click()
    Dim counter&, i&, l&, counters() As Long
    Dim s$, words() As String
    Dim ll&, lOldHighLight&
    s = Trim$(InputBox("Type words"))
    If Len(s) Then Else Exit Sub
    words = Split(s, " ")
    With ActiveDocument
        ll = .Paragraphs.Count
        ReDim counters(1 To ll)
        For i = 1 To ll
            For Each v In words
                If Len(v) Then
                    For Each vv In .Paragraphs(i).Range.words
                        If UCase(Trim$(vv)) = UCase(v) Then counter = counter + 1
                    Next
                    counters(i) = counters(i) + counter
                    counter = 0
                End If
            Next
        Next
        For i = 1 To ll
            If counters(i) > l Then l = counters(i): counter = i
        Next
        If counter Then
            .Paragraphs(counter).Range.Select
            lOldHighLight = Options.DefaultHighlightColorIndex
            Options.DefaultHighlightColorIndex = wdBrightGreen
            With Selection.Find
                .ClearFormatting
                With .Replacement
                    .ClearFormatting
                    .Highlight = True
                End With
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindStop
                .Format = True
                .MatchCase = False
                .MatchWholeWord = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                For Each v In words
                    .Text = v
                    .Execute Replace:=wdReplaceAll
                Next
            End With
            Selection.Collapse
            Options.DefaultHighlightColorIndex = lOldHighLight
            s = "Paragraph No " & counter & vbCrLf & "Finded: " & l
            ActiveWindow.ScrollIntoView .Paragraphs(counter).Range
        Else
            s = "Find is missed!"
        End If
    End With
    MsgBox s
End Sub