Message PopUp issue

[cdsaroma]

I have this code below:

Private Const reminder As Integer = 1
Private reminderNext As Variant

Public Sub remindMe()

  
    myrows = Range("A1").CurrentRegion.Rows.Count
    TODAY = Date
     
    For thisrow = 2 To myrows
        If (Cells(thisrow, "C") = "x") Then
         
            thisdate = CDate(CDate(Cells(thisrow, "A")))
             
            If (thisdate >= TODAY) Then
                 
                    task = task & vbCrLf & " Call " & Cells(thisrow, "B") & " " & Format(Cells(thisrow, "D"))
               
            End If
        End If
     
    Next
     
    If (task <> "") Then MsgBox task
     
     
    reminderNext = Now + TimeSerial(0, reminder, 0)
    Application.OnTime reminderNext, "ThisWorkbook.remindMe", , True
     
End Sub

Private Sub Workbook_Open()

Call remindMe

End Sub

rows:
A= date column
B= persons name
C= x
D= text Today

It works but it seems to loop even if I press OK on the box. Sometimes I have to press it 5 times before it will go away.
Is there a way to stop the macro once the OK button is pressed?
(of course macro will start again on wookbook open which is correct)
In another words I only want it to run once per wookbook open if the criteria (todays date) is met.

thanks
Paul

 

[cdsaroma]

I think I worked it out.
I removed this:

reminderNext = Now + TimeSerial(0, reminder, 0)
    Application.OnTime reminderNext, "ThisWorkbook.remindMe", , True