Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 22

Thread: Stop user from closing workbook until conditions apply

  1. #1

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


    [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

  2. #2
    VBAX Regular
    Joined
    Jun 2004
    Location
    Denmark
    Posts
    58
    Location
    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

  3. #3
    VBAX Regular
    Joined
    Jun 2004
    Location
    Denmark
    Posts
    58
    Location
    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

  4. #4
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    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]

  5. #5
    VBAX Regular
    Joined
    Jun 2004
    Location
    Denmark
    Posts
    58
    Location
    Hi Jacob
    Nice one. Very userfreindly :-)

    br
    Tommy Bak

  6. #6
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    Quote Originally Posted by tommy bak
    Hi Jacob
    Nice one. Very userfreindly :-)

    br
    Tommy Bak
    Thanks

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

  8. #8
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    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.

  9. #9
    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??

  10. #10
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    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?

  11. #11
    Would that be...

    [VBA]
    ThisWorkbook.SaveAs MyPath
    [/VBA]

  12. #12
    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??

  13. #13
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    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]

  14. #14
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    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]

  15. #15
    Sooooooperb!!

    Works an absolute treat my friend. Many thanks indeed.

  16. #16
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,710
    Location
    Glad to help

    Take Care

  17. #17
    VBAX Newbie
    Joined
    Dec 2016
    Posts
    3
    Location

    Workbook Event BeforeClose but how can I save a blank template and exit?

    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 View Post
    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]

  18. #18
    VBAX Expert
    Joined
    May 2016
    Posts
    603
    Location
    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]

  19. #19
    VBAX Newbie
    Joined
    Dec 2016
    Posts
    3
    Location

    ???

    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 View Post
    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]

  20. #20
    VBAX Expert
    Joined
    May 2016
    Posts
    603
    Location
    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]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •