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.
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
Related
I have a word document with field in the end of the document to update filepath, last saved date & last save by. I need these to update on the closing of the file.
I am running an Autoclose macro that updates the fields. The problem is that I need the workbook to save BEFORE these fields are updated, so the last save date and the last save by will update.
I am going to recreate the "Would you like to save changes" message box at the start of the macro, with a yes/no/cancel option. I have 2 questions
1- If the user says No or Cancel..how do I suppress the system generated Would you like to save to avoid a repeat of the same question (or pass along their response to my version of the question to the system so they don't see it)
2 - If the pick cancel, how do I stop the system action of closing the file?
What i have below I found online , the sendkeys (ESC) is not stopping the system close.`
Sub AutoClose()
'if the document is already saved
If ActiveDocument.Saved = True Then
'update all fields, save, close without prompt
Else
'which would be the document's status is not saved
answer = MsgBox("Yes No Cancel Example", vbYesNoCancel)
'above is do you want to save
If answer = vbYes Then
MsgBox "Yes"
ElseIf answer = vbNo Then
'dont save, dont update, close file without prompt
Else
'this is the cancel, so dont update, dont close
ActiveDocument.Saved = True
SendKeys "{ESC}"
End If
End If
End Sub
Perhaps:
Sub AutoClose()
Application.ScreenUpdating = False
Dim Rslt
With ActiveDocument
If .Saved = True Then
Call UpdateFields
.Save
Else
Rslt = MsgBox("Save changes and close, or discard changes and close?", vbYesNoCancel)
If Rslt = vbYes Then
Call UpdateFields
.Save
ElseIf Rslt = vbNo Then
.Saved = True
Else
Call UpdateFields
Application.ScreenUpdating = True
Exit Sub
End If
End If
End Sub
Sub UpdateFields()
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
End Sub
I followed a few simple comments on how to pop a confirmation box before executing a script, but sadly, if I press yes, the script doesn't run.
Private Sub Overwrite_Btn_Click()
If MsgBox("Yes?", vbOKCancel) = ok Then
Me.Product_Quantity = Me.Quantity_Input
Else
Exit Sub
End If
End Sub
I'm trying to set Product_Quantity equaling Quantity_Input, and although it works without the MsgBox command, it doesn't with it.
What am I doing wrong?
Instead of If MsgBox("Yes?", vbOKCancel) = ok Then try: If MsgBox("Yes?", vbOKCancel) = vbOK Then
Typically the interactions with forms will return one constant from a set of several constants. Those are catalogged in enums. In this case you have several constants in the VbMsgBoxResult class, and vbOK is a constant with value 1, which is returned from clicking the ok button.
Actually, If MsgBox("Yes?", vbOKCancel) = 1 Then would work as well, but it is harder to remember that clicking Ok returns 1 then simply stating a constant named vbOK
In object explorer (F2 on the VBE), searching for VbMsgBoxResult will give all possible results that comes from interacting with a message box.
https://www.techonthenet.com/access/constants/msgbox_ret.php
1) Dim a variable as integer.
2) Check for value of integer equal to 6, or check for vbYess
3) ?????
4) Profit
borrowed from link
Dim LResponse As Integer
LResponse = MsgBox("Do you wish to continue?", vbYesNo, "Continue")
If LResponse = vbYes Then
{...statements...}
Else
{...statements...}
End If
Single line:
If MsgBox("Yes?", vbOKCancel) <> vbOk then Exit Sub
'continue code here.
More Information:
MSDN : MsgBox Function (Office/VBA)
Hi I am working on patient management tool where in i wanted to have patient engagement status fields as open,close and reopen. when i change the closed patient to reopen it should add it as new record instead of updating the current record. I have tried to do it in the "cmdsave" to check for status and then add as new or update.
the issue is whenever i changed the combo box, the value is getting saved in the table even before i clicked the save command.
Private Sub CmdSaveEng_Click()
On Error GoTo CmdSaveEng_Click_Err
On Error Resume Next
Call checkReopenexists
If pExists = False Then
saved = True
Call addNewRecord
Me.CmdSaveEng.Enabled = False
saved = False
Exit Sub
Else
saved = True
DoCmd.RunCommand acCmdSaveRecord
Me.CmdSaveEng.Enabled = False
saved = False
If (MacroError <> 0) Then
Beep
MsgBox MacroError.Description, vbOKOnly, ""
End If
Beep
MsgBox "Data Saved Successfully", vbInformation, "Save"
End If
CmdSaveEng_Click_Exit:
Exit Sub
CmdSaveEng_Click_Err:
MsgBox Error$
Resume CmdSaveEng_Click_Exit
End Sub
You can't do it that way.
Create a button that will create a copy of the current record, then move to the copied record for further editing:
Copy record to new record
I have a macro that calls a number of other macros which work fine, but I would like to make it more automated - at the moment it requires users to click 'Yes' or 'No' or other similar options as the macro runs.
A sample is below:
Sheets("Macro").Select
Sheets("Hidden").Visible = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
intList = MsgBox("HerpDerp?", vbYesNo + vbQuestion)
If intList = vbNo Then Exit Sub
If (Range("asd").Value = "sdf" Or Range("asd").Value = "dfg") Then
othermacro1
othermacro2
Else
othermacro3
othermacro4
End If
Sheets("Macro").Select
Application.DisplayAlerts = True
Sheets("Hidden").Visible = False
MsgBox "DerpHerp", vbInformation + vbOKOnly, "Save"
End Sub
Through troubleshooting I would have thought that setting alerts to automatically not display this would circumvent the problem, but users need to click more divers buttons than 'yes' or 'no' in order to continue with the macro, which may be why this is occurring (though I would have anticipated that this would just make the alert not appear...).
Any help on this would be greatly appreciated and any additional info required can easily be supplied.
Thanks in advance for the help!
Check this sample code and hope this helps you:
Source Code:
Sub MsgBoxDemo()
Dim Answer As Long
Answer = MsgBox("Select Yes or No", vbExclamation + vbYesNo, "Reply")
If Answer = vbYes Then
MsgBox "Yes"
End If
If Answer = vbNo Then
MsgBox "No"
End If
End Sub
I am sending data from frmSearchEmployeeWorksheets to frmStatsCorr which runs a query (qryStatsCorr). On frmStatsCorr I am checking to make sure the query returns records otherwise I will Msg the user and return to the search form. My problem is that I am having problems 'ignoring' the 2501 caused by the DoCmd.OpenForm ("frmStatsCorr") which I learned here on Stackoverflow...
What am I doing wrong that is causing me major Access VBA Frustration??
This is the sub on the Search form (frmSearchEmployeeWorksheets):
Private Sub btnSearch_Click()
' I only change focus to force the updated data to submit to query
Me.[txtEmployee].SetFocus
Me.txtShift.SetFocus
If txtUnit = "7" Then
'First close the form in order to update
DoCmd.Close acForm, "frmStatsCorr"
' Open Stats form
On Error GoTo myErr
**DoCmd.OpenForm ("frmStatsCorr") 'causes error**
End If
myExit:
Exit Sub
myErr:
Echo True
If Err.Number = 2501 Then GoTo myExit
MsgBox Err.Description
GoTo myExit
End Sub
In frmStatsCorr I simply check to make sure the query returns records if not I inform the user, close the form, and return to the frmSearchEmployeeWorksheets
Private Sub Form_Load()
If strFormStatus = "view" Then
If DCount("*", "qryStatsCorr") = 0 Then
MsgBox "Your search does not produce any results. Try a different search.", vbOKOnly
DoCmd.Close
DoCmd.OpenForm ("frmSearchEmployeeWorksheets")
Exit Sub
End If
txtDay = WeekdayName(Weekday(Me.WorkDate)) 'This line returns an error so I check for an empty query and return to the search form.
Me.[WorkDate].SetFocus
Me.txtUnit.Enabled = False...
I'm unsure how well I understand your code or the logic behind it. My hunch is you should check the DCount result from btnSearch_Click, and not fiddle with closing then re-opening frmStatsCorr, and having frmStatsCorr close itself when it contains no data. Just do not open frmStatsCorr when it will not contain data.
If the current form (frmSearchEmployeeWorksheets) which holds your btnSearch_Click procedure contains unsaved data changes, you can save them with Me.Dirty = False
Private Sub btnSearch_Click()
Dim strPrompt As String
If Me.Dirty Then ' unsaved data changes
Me.Dirty = False ' save them
End If
If Me.txtUnit = "7" Then
If DCount("*", "qryStatsCorr") = 0 Then
strPrompt = "Your search does not produce any results. " & _
"Try a different search."
MsgBox strPrompt, vbOKOnly
Else
' if frmStatsCorr is open, just Requery
' else open frmStatsCorr
If CurrentProject.AllForms("frmStatsCorr").IsLoaded Then
Forms("frmStatsCorr").Requery
Else
DoCmd.OpenForm "frmStatsCorr"
End If
' uncomment next line to close current form
'DoCmd.Close acForm, Me.Name
End If
End If
End Sub
If frmStatsCorr is open and you need to check whether it is in Design View, examine its CurrentView property.
Forms("frmStatsCorr").CurrentView ' Design View = 0
I suggested that approach because I suspected frmStatsCorr's Form_Load may trigger the 2501 error when it closes itself. But I'm not certain that's the cause of the error and I'm not motivated enough to set up a test.
If you still have 2501 errors with the approach I suggested, there are two other possible causes I've encountered:
corruption
broken references