Stop user from closing workbook until conditions apply

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


[VBA]
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
[/VBA]

Cheers :hi:

Hi
Set Cancel = True


[VBA]
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
[/VBA]

br
Tommy Bak

sorry... I don't think that your code will work.. At least it doesn't for me
Try this one instead

[VBA]
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
[/VBA]

br
Tommy Bak

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.

[vba]
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
[/vba]

Hi Jacob
Nice one. Very userfreindly :-)

br
Tommy Bak

Quote:

---

Originally Posted by tommy bak

Hi Jacob
Nice one. Very userfreindly :-)

br
Tommy Bak

---

Thanks :)

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!!!

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.

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??

Of course we can do this.

[VBA]
Dim Desktop As Object
Dim MyPath As String

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

[/VBA]

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

Would that be...

[VBA]
ThisWorkbook.SaveAs MyPath
[/VBA]

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??

Quote:

---

Originally Posted by BexleyManor

Would that be...

[VBA]
ThisWorkbook.SaveAs MyPath
[/VBA]

---

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

[VBA]
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)

[/VBA]

So to put it all together:

[VBA]
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
[/VBA]

Sooooooperb!!

Works an absolute treat my friend. Many thanks indeed.

Glad to help :)

Take Care

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!)

Quote:

---

Originally Posted by Jacob Hilderbrand

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.

[vba]
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
[/vba]

---

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

[VBA]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


[/vba]

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.

Quote:

---

Originally Posted by offthelip

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

[VBA]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


[/VBA]

---

Quote:

---

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:

[vba]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

[/vba]

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?

One way to do this is to ask the question as you close by changing the message box in the original:

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

change this to:

[VBA]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

[/VBA]