wend without while - excel

Question

Getting wend without while error: I am trying to extract paragraph with particular keyword and Color from Doc to Excel.
Keywords for a paragraph is written in Sheet 1 row 2 to last row.
Next Paragraph with a keyword is extracted in Sheet2.
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.