PDA

View Full Version : [SOLVED] Stop user from closing workbook until conditions apply



BexleyManor
08-13-2004, 01:16 AM
Hi all,

I have a worksheet that requires specific cells to have data input in by the user before the workbook is closed. The problem is my users still manage NOT to complete all the required cells!!

What I'm looking for is some way of stopping them from closing/saving the workbook until the conditions are met.

I've come up with the following code so far but I'm looking for the code that will stop the workbook from being closed.

Any suggestions?? :help



Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36").Value = "" Then
MsgBox "Incomplete fields. Please check your data ensuring any required cells are complete otherwise you will not be able to close or save the workbook"

'What do I need to code here to stop workbook from being closed????
End If
End Sub


Cheers :hi:

tommy bak
08-13-2004, 01:21 AM
Hi
Set Cancel = True



Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36").Value = "" Then
MsgBox "Incomplete fields. Please check your data ensuring any required cells are complete otherwise you will not be able to close or save the workbook"
Cancel = True
'What do I need to code here to stop workbook from being closed????
End If
End Sub


br
Tommy Bak

tommy bak
08-13-2004, 01:35 AM
sorry... I don't think that your code will work.. At least it doesn't for me
Try this one instead


Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Application.CountA(Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36")) _
< Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36").Cells.Count Then
MsgBox "Incomplete fields. Please check your data ensuring any required cells are complete otherwise you will not be able to close or save the workbook"
Cancel = True
'What do I need to code here to stop workbook from being closed????
End If
End Sub


br
Tommy Bak

Jacob Hilderbrand
08-13-2004, 01:41 AM
You can try something like this. It will stop closing, as well as tell the user what cells need to be filled out, then it will select those cells.


Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Rng1 As Range
Dim Rng2 As Range
Dim Prompt As String
Dim Cell As Range
Dim AllowClose As Boolean

AllowClose = True
Set Rng1 = Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36")
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete:" & vbCrLf & vbCrLf

For Each Cell In Rng1
If Cell.Value = vbNullString Then
Prompt = Prompt & Cell.Address(False, False) & vbCrLf
AllowClose = False
If Rng2 Is Nothing Then
Set Rng2 = Cell
Else
Set Rng2 = Union(Rng2, Cell)
End If
End If
Next
If AllowClose Then
Else
MsgBox Prompt, vbCritical, "Incomplete Data"
Cancel = True
Rng2.Select
End If

End Sub

tommy bak
08-13-2004, 01:45 AM
Hi Jacob
Nice one. Very userfreindly :-)

br
Tommy Bak

Jacob Hilderbrand
08-13-2004, 01:46 AM
Hi Jacob
Nice one. Very userfreindly :-)

br
Tommy Bak
Thanks :)

BexleyManor
08-13-2004, 01:53 AM
Truly great work guys....

In response, I got Tommy B's first suggestion to work which I like because I'm a lazy coder and always look for a quick and easy!

Jacob, your solution resembles a piece of art my friend! Far too eloquent for the likes of me and my tatty coding style... I can only dream of writing such fine solutions ...

Anyway, I would just like to thank you both for your fantastic input.

VBAX Forum saves the day, Again!!!

Jacob Hilderbrand
08-13-2004, 01:59 AM
You're Welcome :)

And so long as you know how to copy and paste, you don't have to worry about coding anything and you can be as lazy as you want. Just come here and someone will help you out.

BexleyManor
08-13-2004, 02:04 AM
Just as an after thought, if the user had completed the sheet properly is there any way to then save the workbook automatically to the users desktop?? The users have a mix of NT and 2K??

Jacob Hilderbrand
08-13-2004, 02:06 AM
Of course we can do this.


Dim Desktop As Object
Dim MyPath As String

Set Desktop = CreateObject("WScript.Shell")
MyPath = Desktop.SpecialFolders("Desktop")



Now you have the path. Do you need the code to save to that path?

BexleyManor
08-13-2004, 02:20 AM
Would that be...


ThisWorkbook.SaveAs MyPath

BexleyManor
08-13-2004, 02:29 AM
My previous suggestion saves a copy of the file as desktop.xls, would it be possible to save as DailyInputs130804.xls DailyInputs being the original workbook name and 130804 being the current date??

Jacob Hilderbrand
08-13-2004, 02:43 AM
Would that be...


ThisWorkbook.SaveAs MyPath

You need to specify the name of the file as well.


Dim Desktop As Object
Dim MyPath As String
Dim MyName As String

Set Desktop = CreateObject("WScript.Shell")
MyPath = Desktop.SpecialFolders("Desktop")
MyName = "DailyInputs" & Format(Date, "ddmmyy") & ".xls"

ThisWorkbook.SaveAs (MyPath & "\" & MyName)

Jacob Hilderbrand
08-13-2004, 02:51 AM
So to put it all together:


Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Rng1 As Range
Dim Rng2 As Range
Dim Prompt As String
Dim Cell As Range
Dim AllowClose As Boolean
Dim Desktop As Object
Dim MyPath As String
Dim MyName As String

Set Desktop = CreateObject("WScript.Shell")
MyPath = Desktop.SpecialFolders("Desktop")
MyName = "DailyInputs" & Format(Date, "ddmmyy") & ".xls"
AllowClose = True
Set Rng1 = Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36")
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete:" & vbCrLf & vbCrLf

For Each Cell In Rng1
If Cell.Value = vbNullString Then
Prompt = Prompt & Cell.Address(False, False) & vbCrLf
AllowClose = False
If Rng2 Is Nothing Then
Set Rng2 = Cell
Else
Set Rng2 = Union(Rng2, Cell)
End If
End If
Next
If AllowClose Then
ThisWorkbook.SaveAs (MyPath & "\" & MyName)
Else
MsgBox Prompt, vbCritical, "Incomplete Data"
Cancel = True
Rng2.Select
End If

End Sub

BexleyManor
08-13-2004, 02:55 AM
Sooooooperb!!

Works an absolute treat my friend. Many thanks indeed.

Jacob Hilderbrand
08-13-2004, 02:57 AM
Glad to help :)

Take Care

rautenbk
12-07-2016, 02:49 PM
Hi Jacob,

I realize this is a very old post but hoping I can still get a reply!

Your code works wonderfully, I was able to adapt it but it works so well I don't have a way around it and I need to save a template without the data. Is there a way to code in - make it do this except for me? or If I enter some word into a cell? The only thing I've figured out is to save it and force quit from the task manager.

Thank you in advance!

-Karyn (newbie to VBA, learning as I go!)


You can try something like this. It will stop closing, as well as tell the user what cells need to be filled out, then it will select those cells.


Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Rng1 As Range
Dim Rng2 As Range
Dim Prompt As String
Dim Cell As Range
Dim AllowClose As Boolean

AllowClose = True
Set Rng1 = Sheets("Daily Centre Inputs").Range("D6,F6,C8:C18,I6:I18,A22:K22,A29,A36,H36")
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "you will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete:" & vbCrLf & vbCrLf

For Each Cell In Rng1
If Cell.Value = vbNullString Then
Prompt = Prompt & Cell.Address(False, False) & vbCrLf
AllowClose = False
If Rng2 Is Nothing Then
Set Rng2 = Cell
Else
Set Rng2 = Union(Rng2, Cell)
End If
End If
Next
If AllowClose Then
Else
MsgBox Prompt, vbCritical, "Incomplete Data"
Cancel = True
Rng2.Select
End If

End Sub

offthelip
12-08-2016, 06:35 AM
You can put an "if endif" round the main code to detect whether the activeworkbook has a template extension:

Dim btxt, atxt, txtnm As String
txtnm = ActiveWorkbook.Name
atxt = Right(txtnm, 4)
btxt = Left(atxt, 3)
If btxt <> "xlt" Then
' all the other code

End If

rautenbk
12-08-2016, 07:53 AM
I am a bit confused but would appreciate your help. I'm not sure how this works or if it solves my issue, I am telling the workbook to check all the data before allowing close but I want an exception like if I'm the user or if I have like an escape box where I can mark an X.


You can put an "if endif" round the main code to detect whether the activeworkbook has a template extension:

Dim btxt, atxt, txtnm As String
txtnm = ActiveWorkbook.Name
atxt = Right(txtnm, 4)
btxt = Left(atxt, 3)
If btxt <> "xlt" Then
' all the other code

End If

offthelip
12-08-2016, 11:03 AM
I need to save a template without the data
the Excel template has a different extension, which is either xlt or Xltm. what my code is trying to do is detect if the file you are saving is a templete if so it will skip the checks. Irealise there is a slight bug in it because I am not detecting the to file extension correctly. So if you delete all the data, then save the workbook as filename.xlt, the close the workbook, the check will be skipped.
The improved code is:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim btxt, atxt, txtnm As String
txtnm = ActiveWorkbook.Name
atxt = Right(txtnm, 4)
If atxt <> ".xlt" Then
If atxt <> "xltm" Then
' all the other code

End If
End If
End Sub

rautenbk
12-08-2016, 02:32 PM
Thanks, I was looking for a workaround from preventing closing if it is me. I have changed gears and am just using a warning now instead of preventing the closing but still interested if someone has an answer.

You must fill in the data or the workbook will not close. - how do I write an exception in?

offthelip
12-08-2016, 04:21 PM
One way to do this is to ask the question as you close by changing the message box in the original:

orginal:
If AllowClose Then
Else
MsgBox Prompt, vbCritical, "Incomplete Data"
Cancel = True
Rng2.Select
End If

change this to:

Dim ans As Integer


If allowclose Then
Else
ans = MsgBox("Incomplete data, do you want to close", vbYesNo)
If (ans = vbNo) Then

Cancel = True
End If