Adding Yes/No Msg Box to current code.

[Frncis]

The current code that prompts a user user when "Pending"is selected in Column M, works as expected.
Here is the current code:

Private Sub Worksheet_Change(ByVal Target As Range)
' Promts user wnen Pending is selected.
Application.Cursor = xlDefault
  If Not Application.Intersect(Target(1), Me.Columns("M")) Is Nothing Then
   Application.Speech.Speak "Schedule two. appointments on your calendar. The first appointment. is a reminder. to send a contact letter. (if no response from the Phone call). Use the Red date to the right. The second appointment. is a reminder.  two weeks later. to cancel the consult. if NO response from earlier attempts.", SpeakAsync:=True
   VBA.MsgBox "Schedule two appointments on your calendar. The first appointment is a reminder to send a contact letter (if no response from Phone call.  Use the Red date to the right. The second appointment is a reminder two weeks later to cancel the consult, if NO response from earlier attempts.", vbOKOnly + vbInformation, _
                       "Vocational Services Reminder"
                       
     'Opens Outlook appointment Calendar.
Dim olApp As Object ' Outlook.Application
Set olApp = CreateObject("Outlook.Application")
olApp.Session.GetDefaultFolder(olFolderCalendar).Display
End If
End Sub

However, a user needs to delete "Pending", when a response is received, or when a consult is Canceled. What I see happening is: Situation 1) a user receives a response, "Pending" is deleted, Outlook Calendar opens. Situation 2) "Pending" is deleted & the calendar does not open. The problem I am having, is the code & location to give the user the 2 options for situation 1. Is what I am asking possible, if so how? I have attached a 2 sheet sample,

 

[Frncis]

Problem Solved. I forgot about "Worksheet_BeforeDelete()" Sorry about posting a question that a first year coder would have solved.