Reminder outlook code: Next RowNumber won't continue searching rest of column

[KyleJackMorrison]

Hello,

I would like help trying to get the set reminder code to continue searching the rest of the column once it has action a previous date. It'll set a reminder for the first person then stop working.
This code has been chopped up and acquired from all sorts of locations, so apologize for it being very messy. Feel free to tidy it up if you're happy to.

Sheet Information:
A..........B..........C..........D...............E
Title......First......Last.......Date..........Reminder Set?
Mr.........Kyle......Smith....27-04-17.....No
Miss......Hannah..West......27-04-17.....No

Sub PhaseAlpha()
Dim rowNumber As Long
Dim thisSheet As Worksheet
Dim cellToCheck As Range
Dim LLName As String, LFName As String, LTitle As String, LResponse As Integer
Dim ans As Variant
Dim objReminder As Object, oOutlook As Object
Set appOL = GetObject(, "Outlook.application")
Set objReminder = appOL.CreateItem(1)
Set objReminder1 = appOL.CreateItem(1)
Set thisSheet = ActiveSheet
For rowNumber = 2 To thisSheet.Cells(Rows.Count, 3).End(xlUp).Row
Set Deffer = thisSheet.Cells(rowNumber, 3)
Set cellToCheck = thisSheet.Cells(rowNumber, 3)
    If cellToCheck.Value = DateAdd("d", 10, Date) Then
        LTitle = Sheets("Courses").Range("A" & rowNumber).Value
        LFName = Sheets("Courses").Range("B" & rowNumber).Value
        LLName = Sheets("Courses").Range("C" & rowNumber).Value
        LDate = Sheets("Courses").Range("D" & rowNumber).Value
       If Range("E" & rowNumber).Value = "YES" Then Exit Sub
        LResponse = MsgBox("" & LTitle & " " & LLName & "'s course is on " & Format(LDate, "dddd d mmmm yyyy") & "." & vbNewLine & vbNewLine & "Would you like to create a reminder to book transport?", vbYesNo, "Transport Reminder")
If LResponse = vbYes Then
ASubText = "" & LTitle & " " & LLName & " - Course: " & Format(LDate, "dddd d mmmm yyyy")
ALDate = DateAdd("d", 6, LDate)
            objReminder.Start = LDate
            objReminder.AllDayEvent = True
            objReminder.Subject = ASubText
            objReminder.Location = "London"
            objReminder.Importance = 1
            objReminder.Categories = "Red Category"
            objReminder.ReminderOverrideDefault = True
            objReminder.ReminderSet = True
            objReminder.Save
        BSubText = "BOOK VEHICLE FOR: " & LTitle & " " & LLName & " - PH1(A): " & Format(LDate, "dddd d mmmm yyyy")
        BBodText = "Please book transport for " & LTitle & " " & LFName & " " & LLName
        Sdate = DateAdd("d", -11, LDate)
            objReminder1.Start = Sdate
            objReminder1.AllDayEvent = True
            objReminder1.Subject = BSubText
            objReminder1.Body = BBodText
            objReminder1.BusyStatus = 0
            objReminder1.Location = "London"
            objReminder1.ReminderSet = True
            objReminder1.Categories = "Red Category"
            objReminder1.ReminderOverrideDefault = True
            objReminder1.Importance = 1
            objReminder1.Save
            
            Set objReminder = Nothing


RepeatMsg:
    ans = MsgBox("Would you like to disable this message from re-occurring?", vbYesNo)
   Select Case ans
   Case vbNo
    Exit Sub
   Case vbYes
       Range("E" & rowNumber).Value = "YES"
     Call MsgBox("Reminders have been created successfully", vbInformation)
     Exit Sub
       End Select
Exit Sub


End If
        If LResponse = vbNo Then
            MsgBox "A reminder was not created!", vbCritical
        
        Exit Sub
    End If
End If
Next rowNumber
End Sub

Many thanks in advance.

Kyle

 

[Norie]

Kyle

You seem to be exiting the sub at various points in the code, in particular in this section of the code you have Exit Sub 3 times

RepeatMsg:
                ans = MsgBox("Would you like to disable this message from re-occurring?", vbYesNo)
                Select Case ans
                    Case vbNo
                        Exit Sub
                    Case vbYes
                        Range("E" & rowNumber).Value = "YES"
                        Call MsgBox("Reminders have been created successfully", vbInformation)
                        Exit Sub
                End Select
                Exit Sub


            End If
            If LResponse = vbNo Then
                MsgBox "A reminder was not created!", vbCritical

                Exit Sub
            End If
        End If

When do you want to exit the sub?

 

[KyleJackMorrison]

That might be the problem then, i want to exit the sub once it has checked all rows of the said column.

How would i go about stopping the exit sub and replacing them with what?

I've edited this sections:

        LDate = Sheets("Courses").Range("D" & rowNumber).Value
       If Range("E" & rowNumber).Value = "YES" Then 
End If
        LResponse = MsgBox("" & LTitle & " " & LLName & "'s course is on " & Format(LDate, "dddd d mmmm yyyy") & "." & vbNewLine & vbNewLine & "Would you like to create a reminder to book transport?", vbYesNo, "Transport Reminder")
If LResponse = vbYes Then

Removed the End Sub for End If

However when the LResponse = vbno it wont continue

 

[Norie]

If you remove the all the Exit Sub lines of code then the loop will run its course.

That should fix things, though you might have to adjust some of your If statements in that section.