wend without while

Question

Getting wend without while error: I am trying to extract paragraph with particular keyword and Color from Doc to Excel.

1. Keywords for a paragraph is written in Sheet 1 row 2 to last row.
2. Next Paragraph with a keyword is extracted in Sheet2.
3. I will get a wend without while error when I try to get a paragraph with particular color after the keyword.

Code:

Sub LocateSearchItem()


Dim shtSearchItem As Worksheet
Dim shtExtract As Worksheet
Dim oWord As Word.Application
Dim WordNotOpen As Boolean
Dim oDoc As Word.Document
Dim oRange As Word.Range
Dim LastRow As Long
Dim CurrRowShtSearchItem As Long
Dim CurrRowShtExtract As Long
Dim myPara As Long
Dim myPara1 As Long
Dim I As Long


On Error Resume Next

Set oWord = GetObject(, "Word.Application")
    Set oWord = New Word.Application
If Err Then
    Set oWord = New Word.Application
    WordNotOpen = True
End If

On Error GoTo Err_Handler

oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Open("C:\CC-SyPRS\Automating Verification activity\Work in Progress\Test.docx")

Set shtSearchItem = ThisWorkbook.Worksheets(1)
If ThisWorkbook.Worksheets.Count < 2 Then
    ThisWorkbook.Worksheets.Add After:=shtSearchItem
End If
Set shtExtract = ThisWorkbook.Worksheets(2)

LastRow = shtSearchItem.UsedRange.Rows(shtSearchItem.UsedRange.Rows.Count).Row

For CurrRowShtSearchItem = 2 To LastRow
    Set oRange = oDoc.Range
    With oRange.Find
        .Text = shtSearchItem.Cells(CurrRowShtSearchItem, 1).Text
        .MatchCase = False
        .MatchWholeWord = True
        While oRange.Find.Execute = True
            oRange.Select
            myPara = oDoc.Range(0, oWord.Selection.Paragraphs(1).Range.End).Paragraphs.Count
            myPara1 = myPara + 1
            
            Set objParagraph = oDoc.Paragraphs(myPara1).Range
               For I = 1 To 5
                 If objParagraph.Font.ColorIndex = wdGreen Then
                    shtExtract.Cells(CurrRowShtExtract, 2) = oDoc.Paragraphs(myPara1).Range
                 Else
                    I = I + 1
                     myPara1 = myPara + I
            End If
            

            CurrRowShtExtract = CurrRowShtExtract + 1

            oRange.Collapse wdCollapseEnd

        Wend
    End With
Next CurrRowShtSearchItem

If WordNotOpen Then
    oWord.Quit
End If

'Release object references

Set oWord = Nothing
Set oDoc = Nothing

Exit Sub
Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
If WordNotOpen Then
oWord.Quit
End If

End Sub

Answer 1

This is why proper indentation is really useful.

Sub LocateSearchItem()
    Dim shtSearchItem As Worksheet
    Dim shtExtract As Worksheet
    Dim oWord As Word.Application
    Dim WordNotOpen As Boolean
    Dim oDoc As Word.Document
    Dim oRange As Word.Range
    Dim LastRow As Long
    Dim CurrRowShtSearchItem As Long
    Dim CurrRowShtExtract As Long
    Dim myPara As Long
    Dim myPara1 As Long
    Dim I As Long


    On Error Resume Next

    Set oWord = GetObject(, "Word.Application")
    Set oWord = New Word.Application
    If Err Then
        Set oWord = New Word.Application
        WordNotOpen = True
    End If

    On Error GoTo Err_Handler

    oWord.Visible = True
    oWord.Activate
    Set oDoc = oWord.Documents.Open("C:\CC-SyPRS\Automating Verification activity\Work in Progress\Test.docx")

    Set shtSearchItem = ThisWorkbook.Worksheets(1)
    If ThisWorkbook.Worksheets.Count < 2 Then
        ThisWorkbook.Worksheets.Add After:=shtSearchItem
    End If
    Set shtExtract = ThisWorkbook.Worksheets(2)

    LastRow = shtSearchItem.UsedRange.Rows(shtSearchItem.UsedRange.Rows.Count).Row

    For CurrRowShtSearchItem = 2 To LastRow
        Set oRange = oDoc.Range
        With oRange.Find
            .Text = shtSearchItem.Cells(CurrRowShtSearchItem, 1).Text
            .MatchCase = False
            .MatchWholeWord = True
            While oRange.Find.Execute = True
                oRange.Select
                myPara = oDoc.Range(0, oWord.Selection.Paragraphs(1).Range.End).Paragraphs.Count
                myPara1 = myPara + 1
        
                Set objParagraph = oDoc.Paragraphs(myPara1).Range
                For I = 1 To 5
                    If objParagraph.Font.ColorIndex = wdGreen Then
                        shtExtract.Cells(CurrRowShtExtract, 2) = oDoc.Paragraphs(myPara1).Range
                    Else
                        I = I + 1
                        myPara1 = myPara + I
                    End If

                    CurrRowShtExtract = CurrRowShtExtract + 1
                    oRange.Collapse wdCollapseEnd
                ' Oops! No closing tag for the 'For' statement. Add 'Next I' here
            Wend
        End With
    Next CurrRowShtSearchItem

    If WordNotOpen Then
        oWord.Quit
    End If

    'Release object references

    Set oWord = Nothing
    Set oDoc = Nothing

    Exit Sub
Err_Handler:
    MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
    If WordNotOpen Then
        oWord.Quit
    End If
End Sub

The error message is quite misleading anyway, as @freeflow mentioned By the way, you have a With on line 41, which is not closed on line 45. As you do not use the Find object anymore, you can close it and start the while loop separately.