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

First, you only get one worksheet_beforesave event. You could combine each of
your routines into one subroutine -- essentially a cut|paste solution.

Or you could take another approach...create a worksheet level name in each of
those 4 worksheets that has the same name.

You can select the cells on the Main sheet
then type:
Main!MustBeCompleted
in the namebox (to the left of the formula bar)

Repeat for each of the other 3 sheets
Start!MustBeCompleted
Amendments!MustBeCompleted
Leaver!MustBeCompleted

Then you could use a routine like:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)

Dim WksNames As Variant
Dim wCtr As Long

WksNames = Array("Main", "Start", "Amendments", "Leaver")

For wCtr = LBound(WksNames) To UBound(WksNames)
With Me.Worksheets(WksNames(wCtr)).Range("mustbecomplet ed")
If Application.CountA(.Cells) = .Cells.Count Then
'all have something in them
Else
Cancel = True
MsgBox "Please fill in the Green Cells in " & .Parent.Name
End If
End With
Next wCtr

End Sub

If you change the green cells, you'll have to fix the name, too. Just deleting
it (insert|Name|define|delete) and then recreating it will be easier than
modifying it.


wrote:

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

--

Dave Peterson

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

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

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