Results 1 to 2 of 2
2014-02-14, 10:02 #1
- Join Date
- Feb 2014
- Thanked 0 Times in 0 Posts
Before close event works, however need a way to close form when done
I have an Excel workbook where I have a beforeclose event and this event looks for certain fields to be filled in and then when the user tries to close if they are not all filled in it will highlight what they missed. Then they can close when done and it will automatically saveas a file name and to a certain area. They can do this numerous times because they often have 5-10 audits to fill out and can do it by pulling up the workbook one time and doing it all without a final close of the form.
The problem is, when they are done and want to close all together, it will continue to prompt them to fill in the certain fields. I do not want them to have to fill in the fields and then save and close where it would save the last bit of data they entered. It should always be a blank template to begin with, however it is a .xlsm. I just want to program either in the beforeclose event a way for them to finally get out when done or in a beforesave that if they are complete done they can click on the blue disk (SAVE) and it will shutdown the form. I cannot program the event I have in the beforeclose in the save because that sends everything into this crazy loop.
Here is my code:
Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Start As Boolean Dim Rng1 As Range Dim Prompt As String, RngStr As String Dim Cell As Range Dim wbNewPath As String Sheets("Form").Unprotect Password:="audit" Set Rng1 = Sheets("Form").Range("B4, B7, B8, B9, B12, B74, G9, A16, B10, D10, E74, E77") 'message is returned if there are blanks or no value in required fields Prompt = "Please make sure are highlighted fields are filled in." & vbCrLf & _ "The following cells are incomplete and have been highlighted yellow:" _ & vbCrLf & vbCrLf Start = True 'highlights the blank cells For Each Cell In Rng1 If Cell.Value = vbNullString Or Cell.Value = 0 Or Cell.Value <= 0 Then Cell.Interior.ColorIndex = 6 ' color yellow If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf Start = False RngStr = RngStr & Cell.Address(False, False) & ", " Else Cell.Interior.ColorIndex = 0 '** no color End If Next Sheets("Form").Protect Password:="audit", _ UserInterFaceOnly:=True If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2) If RngStr <> "" Then MsgBox Prompt & RngStr, vbCritical, "Incomplete Data" Cancel = True Else 'saves the changes before closing Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _ "\Documents\Audits\" & Range("B9").Text & Chr(32) & Range("B7").Text & _ Chr(32) & Format(Range("B10").Value, "MM-DD-YYYY") & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=True Application.DisplayAlerts = True End If Set Rng1 = Nothing ActiveSheet.Protect End Sub
2014-02-14, 14:00 #2
- Join Date
- Mar 2004
- Manning, South Carolina
- Thanked 894 Times in 819 Posts
Welcome to the Lounge as a New Poster!
This should do what you want.
Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) If vbYes = MsgBox("Do you want to exit now?", _ vbYesNo + vbInformation, _ "Exit Selection:") Then Cancel = False Else Cancel = True '*** Exit Excel NOW - Remove this is for testing your code handles this. *** ' *** Your Existing Code Here *** End If End Sub