Loop whole word 2007 document using vba

I am working on a user form for finding specific phrases and commenting them according to certain criteria. I have trouble adding comments for all found phrases in the document. It only changes the first found phrase although it selects all occurrences of the phrase. How can i modify this code for the whole content?

Here is my code:

 If Criteria2 <> "" Then
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = Criteria2
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .开发者_Go百科MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
        End With
       On Error Resume Next
        With Selection
            .Comments.Add Range:=Selection.Range, Text:="SPE 2"
        End With
End If

Ok Here is the new code and it is not working as expected:

Selection.Find.ClearFormatting
        With Selection.Find
           .Text = CritArray(i)
           .Replacement.Text = ""
           .Forward = True
           .Wrap = wdFindContinue
           .Format = False
           .MatchCase = False
           .MatchWholeWord = False
           .MatchWildcards = False
           .MatchSoundsLike = False
           .MatchAllWordForms = False
           Do
               .Execute
               If Not .Found Then
                Exit Do
               ElseIf .Found Then
                FoundCount = FoundCount + 1
                Selection.Comments.Add Range:=Selection.Range, Text:=MessArray(i) & CritArray(i) & "' - found for the" & Str(FoundCount) & ". time"
               End If
            Loop 
        End With

What I get when using this as input:

Testrow1
Testrow2

is the following:

Testrow1 ....................................'Testrow1' - found for the 1. time
Testrow2 ....................................'Testrow2' - found for the 2. time
                                             'Testrow2' - found for the 1. time

I cannot understand why this is happening since the do .. loop should exit if nothing is found. Is it possible that .Wrap = wdFindContinue is the problem? There are three possibilities here:

• wdFindAsk ... asks at the end of document to search again at the beginning (don't want this)
• wdFindContinue ... searches without asking
• wdFindStop ... stops when it first finds the search phrase (don't want this)

Anybody got a clue?

You just need to change it to:

.Execute Replace:=wdReplaceAll

Although having just looked at your answer again (sorry!), do you want to add a comment in for every occurrence changed? As for this, you will have to do loop through each one with

Do
    ' .Execute Replace:=wdReplaceOne if you want to loop AND replace
    .Execute
    If Not .Found Then Exit Do
    Selection.Comments.Add Range:=Selection.Range, Text:="SPE 2"
Loop Until Not .Found

adding the comment until all are found/replaced.

I used now the exact same loop and it works. The new code respectively old code:

For i = 0 To UBound(CritArray)
    With Selection
    .HomeKey wdStory
        With .Find
        .ClearFormatting
            Do While .Execute(FindText:=CritArray(i), _
            Forward:=True)

                Select Case i
                    Case 0: FoundCountC1 = FoundCountC1 + 1
                    Case 1: FoundCountC2 = FoundCountC2 + 1
                    Case 2: FoundCountC3 = FoundCountC3 + 1
                    Case 3: FoundCountC4 = FoundCountC4 + 1
                    Case 4: FoundCountC5 = FoundCountC5 + 1
                    Case 5: FoundCountC6 = FoundCountC6 + 1
                    Case 6: FoundCountC7 = FoundCountC7 + 1
                    Case 7: FoundCountC8 = FoundCountC8 + 1
                    Case 8: FoundCountC9 = FoundCountC9 + 1
                End Select

            Loop
        End With
    End With
Next