Trying to find the range of cells which contain "OCCURS". In this case my expected output range is a1 and a5

A1 03 CL53-BLANKET-IDL OCCURS 3 TIMES.
A2 05 CL53-IDL-CUSTOMER PICTURE S9(7) COMP-3.
A3 05 CL53-IDL-TYPE PICTURE X.
A4 05 CL53-IDL-PERCENT PICTURE S9V9(4) COMP-3.
A5 03 CL53-BLANKET-IDL OCCURS 3 TIMES.

This sample code is bringing me back range if my cell value is "OCCURS"

Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim rng2 As Range
'Sheets("Sheet1").Activate
Set rng_occur = Cells
'Set rng = Range("A1")
Set rng1 = rng_occur.Find(WHAT:="OCCURS", After:=Range("IV65536"), _
LookIn:=xlValues, Lookat:=xlPart)
If Not rng1 Is Nothing Then
fAddr = rng1.Address
Do
If rng2 Is Nothing Then
Set rng2 = rng1
Else
Set rng2 = Union(rng2, rng1)
End If
Set rng1 = rng_occur.FindNext(rng1)
Loop While rng1.Address <> fAddr
End If
If Not rng2 Is Nothing Then
rng2.Select
End If
Looking for experts advise..