Find next not working

I am creating a user form that searches one excel sheet and copies a row and pastes it into another sheet. It will find the first string but will not find the next string.

Dim FindString As Date
Dim Rng As Range
Dim FirstAddress As Variant
Dim ws As Worksheet
Dim oRange As Range
Dim ExitLoop As Boolean
Dim FoundAt As Variant
Dim Rcount As Long
Dim I As Long
Dim MyArr As Variant
Set ws = Worksheets("Sheet1")
Set oRange = ws.Columns(2)

Rcount = 0

FindString = Application.InputBox("Enter Date")

MyArr = Array(FindString)

Set Rng = oRange.find(what:=MyArr(I), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

For I = LBound(MyArr) To UBound(MyArr)

If Not Rng Is Nothing Then
Application.Goto Rng, True

Range(ActiveCell, ActiveCell.Offset(0, 0)).EntireRow.Copy
Sheets(2).Activate
Range("A1").Select
ActiveSheet.Paste


Do While ExitLoop = False

Set FirstAddress = Rng
FoundAt = Rng.Address

Set Rng = oRange.FindNext(Rng)

If FirstAddress = MyArr(I) Then
Rcount = Rcount + 1

If FoundAt = FirstAddress.Address Then
Exit Do
Else
ExitLoop = True
End If
End If

Loop

Else
MsgBox "Nothing found"

End If
Next

End Sub