Mandatory Cell check on multy page workbook
Hi there, can anyone help? I have a workbook made of 4 sheets, Main,
Start, Amendments, Leaver. the main sheet will link you to the sheet required and I need the user to fill in the mandatory cells depending on which sheet is being used, at the end besore saving I need to place a code that will check and return to the sheet if the mandatory cells are blank. but each sheet has different cells so here is the module that governs the whole workbook and will auto print and save with the right paramenters and it works fine: Sub Auto_Open() 'Prepares the display for input 'Remove main menu and toolbars Application.CommandBars(1).Enabled = False Application.CommandBars("Standard").Enabled = True 'False Application.CommandBars("Formatting").Enabled = False Application.CommandBars("Drawing").Enabled = False Application.CommandBars("Reviewing").Enabled = False ActiveWindow.DisplayWorkbookTabs = False 'True Application.DisplayFormulaBar = False Application.StatusBar = "Welcome to the Brookwood Employment Information Form." End Sub Sub Auto_Close() ' this routine prints to the difault printer MsgBox ("I will now print 2 copies of this file, please send one to HR and keep one for your file."), vbYNOnly, ("PRINT FORMS ......") ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True 'this routine saves the file for future consultation Application.StatusBar = "Please Wait - Saving File" workbookname = "EIF - " & Worksheets("starter").Range("c6").Value Set fs = CreateObject("Scripting.FileSystemObject") TestifFolderExists = fs.folderexists("c:\EIF") If TestifFolderExists = False Then MkDir "c:\EIF" Else On Error Resume Next ' Kill "c:\EIF\*.*" On Error GoTo 0 End If RecordFile = "C:\EIF\" & workbookname & Format(Date, " ddd,dd,mmm,yy") & " - " & Format(Time, " HH,MM,SS") & ".xls" ActiveWorkbook.SaveAs RecordFile MsgBox ("Your file has now been saved in C:\EIF, the file has a time stamp so it can be retrieved, you can also change the file name once saved. Thank you"), vbYNOnly, ("Saving...") 'Reverts the display to normal use 'Set environment options With Application .EditDirectlyInCell = True .CellDragAndDrop = True .MoveAfterReturn = True End With Application.CommandBars(1).Enabled = True 'False Application.CommandBars("Standard").Enabled = True 'False Application.CommandBars("Formatting").Enabled = True 'False Application.CommandBars("Drawing").Enabled = True 'False Application.CommandBars("Reviewing").Enabled = True 'False ActiveWindow.DisplayWorkbookTabs = True Application.DisplayFormulaBar = True 'False ThisWorkbook.Saved = True End Sub here below is the code I have to check the empty cells but I can't get it to work Can anyone help me? Thanks Alex Thanks you Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e22,a26,b26,c26,d26,a30,k29 ,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31,q 31,r31,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub |
Mandatory Cell check on multy page workbook
Hi Alex
Considering the comments from Dave your own code can work like this. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim Msg As String Dim checkCells As Range Dim c As Range Select Case ActiveSheet.Name Case "Amendment" Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If Case "Starter" Set checkCells = _ Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e22,a26,b26,c26,d26,a30,k29 ,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31,q 31,r31,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If Case "Leaver" Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If End Select End Sub Regards, Per skrev i en meddelelse ... Hi there, can anyone help? I have a workbook made of 4 sheets, Main, Start, Amendments, Leaver. the main sheet will link you to the sheet required and I need the user to fill in the mandatory cells depending on which sheet is being used, at the end besore saving I need to place a code that will check and return to the sheet if the mandatory cells are blank. but each sheet has different cells so here is the module that governs the whole workbook and will auto print and save with the right paramenters and it works fine: Sub Auto_Open() 'Prepares the display for input 'Remove main menu and toolbars Application.CommandBars(1).Enabled = False Application.CommandBars("Standard").Enabled = True 'False Application.CommandBars("Formatting").Enabled = False Application.CommandBars("Drawing").Enabled = False Application.CommandBars("Reviewing").Enabled = False ActiveWindow.DisplayWorkbookTabs = False 'True Application.DisplayFormulaBar = False Application.StatusBar = "Welcome to the Brookwood Employment Information Form." End Sub Sub Auto_Close() ' this routine prints to the difault printer MsgBox ("I will now print 2 copies of this file, please send one to HR and keep one for your file."), vbYNOnly, ("PRINT FORMS ......") ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True 'this routine saves the file for future consultation Application.StatusBar = "Please Wait - Saving File" workbookname = "EIF - " & Worksheets("starter").Range("c6").Value Set fs = CreateObject("Scripting.FileSystemObject") TestifFolderExists = fs.folderexists("c:\EIF") If TestifFolderExists = False Then MkDir "c:\EIF" Else On Error Resume Next ' Kill "c:\EIF\*.*" On Error GoTo 0 End If RecordFile = "C:\EIF\" & workbookname & Format(Date, " ddd,dd,mmm,yy") & " - " & Format(Time, " HH,MM,SS") & ".xls" ActiveWorkbook.SaveAs RecordFile MsgBox ("Your file has now been saved in C:\EIF, the file has a time stamp so it can be retrieved, you can also change the file name once saved. Thank you"), vbYNOnly, ("Saving...") 'Reverts the display to normal use 'Set environment options With Application .EditDirectlyInCell = True .CellDragAndDrop = True .MoveAfterReturn = True End With Application.CommandBars(1).Enabled = True 'False Application.CommandBars("Standard").Enabled = True 'False Application.CommandBars("Formatting").Enabled = True 'False Application.CommandBars("Drawing").Enabled = True 'False Application.CommandBars("Reviewing").Enabled = True 'False ActiveWindow.DisplayWorkbookTabs = True Application.DisplayFormulaBar = True 'False ThisWorkbook.Saved = True End Sub here below is the code I have to check the empty cells but I can't get it to work Can anyone help me? Thanks Alex Thanks you Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e22,a26,b26,c26,d26,a30,k29 ,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31,q 31,r31,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim checkCells As Range Dim cell As Range Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") For Each cell In checkCells Cancel = Cancel Or IsEmpty(cell) Next cell If Cancel Then MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" End If End Sub |
Mandatory Cell check on multy page workbook
On 1 Jan, 16:22, "Per Jessen" wrote:
Hi Alex Considering the comments from Dave your own code can work like this. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ * * * * * * Cancel As Boolean) ' this will check that all green areas are filled in Dim Msg As String Dim checkCells As Range Dim c As Range Select Case ActiveSheet.Name Case "Amendment" * * Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") * * For Each c In checkCells * * * * If IsEmpty(c) = True Then Cancel = True * * Next * * If Cancel = True Then * * * * Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") * * End If Case "Starter" * * Set checkCells = _ * * Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e2*2,a26,b26,c26,d26,a30,k2 9,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31, q*31,r31,d45") * * For Each c In checkCells * * * * If IsEmpty(c) = True Then Cancel = True * * Next * * If Cancel = True Then * * * * Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") * * End If Case "Leaver" * * Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") * * For Each c In checkCells * * * * If IsEmpty(c) = True Then Cancel = True * * Next * * If Cancel = True Then * * * * Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") * * End If End Select End Sub Regards, Per skrev i en ... Hi there, can anyone help? I have a workbook made of 4 sheets, Main, Start, Amendments, Leaver. the main sheet will link you to the sheet required and I need the user to fill in the mandatory cells depending on which sheet is being used, at the end besore saving I need to place a code that will check and return to the sheet if the mandatory cells are blank. but each sheet has different cells so here is the module that governs the whole workbook and will auto print and save with the right paramenters and it works fine: Sub Auto_Open() 'Prepares the display for input * *'Remove main menu and toolbars * *Application.CommandBars(1).Enabled = False * *Application.CommandBars("Standard").Enabled = True 'False * *Application.CommandBars("Formatting").Enabled = False * *Application.CommandBars("Drawing").Enabled = False * *Application.CommandBars("Reviewing").Enabled = False * *ActiveWindow.DisplayWorkbookTabs = False 'True * *Application.DisplayFormulaBar = False * *Application.StatusBar = "Welcome to the Brookwood Employment Information Form." End Sub Sub Auto_Close() ' this routine prints to the difault printer * *MsgBox ("I will now print 2 copies of this file, please send one to HR and keep one for your file."), vbYNOnly, ("PRINT FORMS ......") * *ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True 'this routine saves the file for future consultation * * * *Application.StatusBar = "Please Wait - Saving File" * * * *workbookname = "EIF - " & Worksheets("starter").Range("c6").Value * * * *Set fs = CreateObject("Scripting.FileSystemObject") * * * *TestifFolderExists = fs.folderexists("c:\EIF") * * * *If TestifFolderExists = False Then * * * * * *MkDir "c:\EIF" * * * *Else * * * *On Error Resume Next ' * * * Kill "c:\EIF\*.*" * * * *On Error GoTo 0 * * * *End If * * * *RecordFile = "C:\EIF\" & workbookname & Format(Date, " ddd,dd,mmm,yy") & " - " & Format(Time, " HH,MM,SS") & ".xls" * * * *ActiveWorkbook.SaveAs RecordFile * *MsgBox ("Your file has now been saved in C:\EIF, the file has a time stamp so it can be retrieved, you can also change the file name once saved. Thank you"), vbYNOnly, ("Saving...") 'Reverts the display to normal use 'Set environment options * *With Application * * * *.EditDirectlyInCell = True * * * *.CellDragAndDrop = True * * * *.MoveAfterReturn = True * *End With * *Application.CommandBars(1).Enabled = True 'False * *Application.CommandBars("Standard").Enabled = True 'False * *Application.CommandBars("Formatting").Enabled = True 'False * *Application.CommandBars("Drawing").Enabled = True 'False * *Application.CommandBars("Reviewing").Enabled = True 'False * *ActiveWindow.DisplayWorkbookTabs = True * *Application.DisplayFormulaBar = True 'False * *ThisWorkbook.Saved = True End Sub here below is the code I have to check the empty cells but I can't get it to work Can anyone help me? Thanks Alex Thanks you Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ * * * * * *Cancel As Boolean) ' this will check that all green areas are filled in * * * *Dim checkCells As Range * * * *Dim cell As Range * * * *Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") * * * *For Each cell In checkCells * * * * * *Cancel = Cancel Or IsEmpty(cell) * * * *Next cell * * * *If Cancel Then * * * * * *MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" * * * *End If * *End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ * * * * * *Cancel As Boolean) ' this will check that all green areas are filled in * * * *Dim checkCells As Range * * * *Dim cell As Range * * * *Set checkCells = Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e2*2,a26,b26,c26,d26,a30,k2 9,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31, q*31,r31,d45") * * * *For Each cell In checkCells * * * * * *Cancel = Cancel Or IsEmpty(cell) * * * *Next cell * * * *If Cancel Then * * * * * *MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" * * * *End If * *End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ * * * * * *Cancel As Boolean) ' this will check that all green areas are filled in * * * *Dim checkCells As Range * * * *Dim cell As Range * * * *Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") * * * *For Each cell In checkCells * * * * * *Cancel = Cancel Or IsEmpty(cell) * * * *Next cell * * * *If Cancel Then * * * * * *MsgBox "Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!" * * * *End If * *End Sub- Hide quoted text - - Show quoted text - Thanks it works fine, and I have wondered if it is possible for the user who does not fill the mandatory areas in but tries to close the workbook to stop the save and in fact not give the option to save as either. many thanks Alex |
Mandatory Cell check on multy page workbook
Hi Alex
Try again. The code check that required cells in all sheets contains data before the user can save the workbook. This code will also work if the user try to use "save as" or if he want to close the workbook and click yes, beeing asked to save the workbook before close. Btw: You can select all the cells in a sheet and then name the selected cells. Enter the name in the field left to the formula line. Then you can use this name in a macro like this: Range("StarterArea").Select Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim Msg As String Dim checkCells As Range Dim c As Range Dim cCount As Single Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Sheets("Amendment").Select Msg = MsgBox _ ("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", _ vbOKOnly, "ATTENTION REQUIRED!!") cCount = cCount + 1 End If Cancel = False Set checkCells = _ Sheets("Starter").Range _ ("c6,k6,c7,k7,c11,c14,c15,c16,c17,c18,c20,e20,e21, e22,a26,b26,c26,d26,a30,k29,k30,l30,n30,o30,q30,r3 0,k31,l31,m31,n31,o31,p31,q31,r31,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Sheets("Starter").Select Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior tosaving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") cCount = cCount + 1 End If Cancel = False Set checkCells = _ Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Sheets("Leaver").Select Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") cCount = cCount + 1 End If If cCount 0 Then Cancel = True End Sub Regards, Per skrev i en meddelelse ... On 1 Jan, 16:22, "Per Jessen" wrote: Hi Alex Considering the comments from Dave your own code can work like this. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) ' this will check that all green areas are filled in Dim Msg As String Dim checkCells As Range Dim c As Range Select Case ActiveSheet.Name Case "Amendment" Set checkCells = Sheets("Amendment").Range("c6,k6,c7,k7,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If Case "Starter" Set checkCells = _ Sheets("Starter").Range("c6,k6,c7,k7,c11,c14,c15,c 16,c17,c18,c20,e20,e21,e2*2,a26,b26,c26,d26,a30,k2 9,k30,l30,n30,o30,q30,r30,k31,l31,m31,n31,o31,p31, q*31,r31,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If Case "Leaver" Set checkCells = Sheets("leaver").Range("c6,k6,c7,k7,c37,l37,c38,d4 1,n41,d45") For Each c In checkCells If IsEmpty(c) = True Then Cancel = True Next If Cancel = True Then Msg = MsgBox("Attention ALL GREEN AREAS must be filled in prior to saving. PLease go back and check your work", vbOKOnly, "ATTENTION REQUIRED!!") End If End Select End Sub Regards, Per - Thanks it works fine, and I have wondered if it is possible for the user who does not fill the mandatory areas in but tries to close the workbook to stop the save and in fact not give the option to save as either. many thanks Alex |
All times are GMT +1. The time now is 12:52 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com