VBA code to protect all worksheets contingent on response - vba

Question

To delete a name and correlating data in the same row on each sheet of my workbook, users need to highlight a name and click a button on the first worksheet. A confirmation window then pops up asking if they are sure. If they click NO, everything remains protected and works fine. If they click YES, all worksheets are unprotected, and a second confirmation window appears - If YES is clicked the second time, the data is deleted from each worksheet and everything is protected after deletion. HOWEVER, if NO is clicked the second time, I can't get my code to then protect everything prior to exiting the sub.
Any help is appreciated, as well as suggestions for resources to help be become more proficient on my own. :)
Here is the code:
Sub DeleteRow()
'this macro deletes the row for a selected patient from worksheet of selected month and all months after that
'variables
Dim PatientName As String, PatientRow As Long, w As Long
Dim pRow As Long, lRow As Long, LookUpRng As Range, answer As Long
Dim rArray() As Variant, sArray As Variant
ReDim rArray(0)
ReDim sArray(0)
With ActiveSheet
ActiveSheet.Unprotect "arafluid"
PatientName = .Range("d" & ActiveCell.Row)
PatientRow = ActiveCell.Row
.Rows(PatientRow).Interior.ColorIndex = 4
'check that user want has selected correct patient
answer = MsgBox("Do you want to permanently remove patient " & vbCr & vbCr & _
PatientName & " from ALL months in this workbook?", vbYesNo, "Confirmation")
.Rows(PatientRow).Interior.ColorIndex = -4142
If answer = vbNo Then ActiveSheet.Protect "arafluid"
If answer <> vbYes Then Exit Sub
'check that it is safe to delete rows in future sheets
For w = Worksheets.Count To ActiveSheet.Index Step -1
With Sheets(w)
Sheets(w).Unprotect "arafluid"
pRow = 0
lRow = .Range("d10").CurrentRegion.Rows.Count + 9
Set LookUpRng = .Range("d10" & ":d" & lRow)
On Error Resume Next
pRow = Application.WorksheetFunction.Match(PatientName, LookUpRng, 0) + 9
If Err.Number <> 0 Then
Trail = Trail & vbCr & " " & .Name & " Not Found!"
Else
Trail = Trail & vbCr & " " & .Name & " ok"
' add value on the end of the arrays
ReDim Preserve rArray(UBound(rArray) + 1) As Variant
ReDim Preserve sArray(UBound(sArray) + 1) As Variant
rArray(UBound(rArray)) = pRow
sArray(UBound(sArray)) = w
End If
On Error GoTo 0
End With
Next w
'check that user still wants to delete
answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _
PatientName & vbCr, vbYesNo, "Are you sure?")
If answer <> vbYes Then Exit Sub
If answer <> vbNo Then
For a = Worksheets.Count To ActiveSheet.Index Step -1
Sheets(a).Protect "arafluid"
Next a
End If
'delete rows for selected patient
For d = 1 To UBound(sArray)
Sheets(sArray(d)).Rows(rArray(d)).EntireRow.Delete
Next d
End With
'loop through all sheets in the workbook.
For w = 1 To Sheets.Count
Sheets(w).Protect "arafluid"
Next w
End Sub

Answer 1

You are exiting the Sub if the user said "no". Change these lines after the second MessageBox:
answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _
PatientName & vbCr, vbYesNo, "Are you sure?")
If answer = vbNo Then 'This will test if user said "No" and will protect the sheets
For a = Worksheets.Count To ActiveSheet.Index Step -1
Sheets(a).Protect "arafluid"
Next a
Exit Sub
End If
As a note, after the first MsgBox you have the same situation with two If statements for the same thing, you could simplify them as:
If answer = vbNo Then
ActiveSheet.Protect "arafluid"
Exit Sub
End If