0

My quest to complete my project is nearly done im just facing one final issue with my code.

Sub DeletePatientCheck()
'check if patient record exists before deleting'
Dim s As Worksheet
On Error Resume Next
'Check if Patient Record already exists'
For Each s In Sheets
    If s.Name = Selection Then
    Worksheets(s.Name).Activate
    Call DeleteRecord
End If
Next s
MsgBox "*No Patient Record Found!*"

End Sub

Sub DeleteRecord()
'Confirm delete?'
Answer = MsgBox("Are you sure you want to delete this Patient Record?", 
vbQuestion + vbYesNo, "Delete Patient Record")

If Answer = vbNo Then GoTo Skip
If Answer = vbYes Then
'It's benny, lets just double check'
Answer = MsgBox("Are you absolutely sure!", vbQuestion + vbYesNo, "Delete 
Patient Record - AYS")
If Answer = vbNo Then GoTo Skip
If Answer = vbYes Then
ActiveSheet.Delete
Sheets("Menu").Select
MsgBox "*Patient Record has been deleted - If done in error please use 
previous document version*"
End If
End If
Skip:
Sheets("Menu").Select
End Sub

Basically, when the user submits a "no" response to the Answer msg box under sub DeleteRecord() the code currently brings it back to sub deletepatientcheck and goes to the msg box "No Patient Record found" . This happens even when a record is found.

What I am trying to do is if a no response is given then bring up a different message box saying "Delete request cancelled" instead of the MsgBox "No Patient Record Found!". But no matter what IF/then function or Skip: i use it always displays the "No patient record found" msg box. Can anyone help? happy to explain further if required. Thanks in advance.

Dan Sutton
  • 63
  • 2
  • 13
  • I hope this is just a pet project and you're not using it in actual medical context. Even then - PLEASE do not use GOTO statements. Back in early 90's, they were considered evil but sometimes necessary. Today they are completely unnecessary. Perhaps you will be surprised to find out that your code is suddenly a lot more predictable and easier to troubleshoot, once you get rid of the GOTO blocks. Better yet - do not use Excel spreadsheets for shared (multi-tenanted) applications. – Michal Jun 11 '18 at 22:49
  • haha don't worry this is just a pet project and not for real world medical application. – Dan Sutton Jun 11 '18 at 22:59

1 Answers1

0

This should work for you. Check the value of Boolean variable Exists before displaying your MsgBox.

Sub 1:

Sub DeletePatientCheck()
'check if patient record exists before deleting'
Dim s As Worksheet
On Error Resume Next
'Check if Patient Record already exists'
Dim Exists As Boolean
For Each s In Sheets
    If s.Name = Selection Then
        Worksheets(s.Name).Activate
        Call DeleteRecord
        Exists = True
    End If
Next s

If Not Exists Then MsgBox "*No Patient Record Found!*"

End Sub

Sub 2: (Recommendations) You can avoid coding the vbNo by just coding for vbYes, and using the Else statement to address the vbNo.

Also notice that you can avoid using the GoTo Skip: method by just calling the task immediately and then using Exit Sub. This link goes into further detail about Goto.

Sub DeleteRecord()
'Confirm delete?'
Dim Answer As String, Answer1 As String
Answer = MsgBox("Are you sure you want to delete this Patient Record?", vbQuestion + vbYesNo, "Delete Patient Record")

If Answer = vbYes Then
    Answer1 = MsgBox("Are you absolutely sure!", vbQuestion + vbYesNo, "Delete Patient Record - AYS")
        If Answer1 = vbYes Then
            ActiveSheet.Delete
            Sheets("Menu").Select
            MsgBox "*Patient Record has been deleted - If done in error please use previous document version*"
        Else
            MsgBox ("Delete Request Cancelled")
            Sheets("Menu").Select
            Exit Sub
        End If
Else
    MsgBox ("Delete Request Cancelled")
    Sheets("Menu").Select
    Exit Sub
End If

End Sub
urdearboy
  • 14,439
  • 5
  • 28
  • 58
  • Thank you for your help, had to throw in some End commands, which i know is not great but its only me who will be editing it going forward, otherwise it kept doing the delete request for each sheet .... got it working anyway so thanks for helpin me get there. – Dan Sutton Jun 11 '18 at 23:31
  • What “Ends”? This ran fan on my end as is – urdearboy Jun 12 '18 at 01:46