Restricting close workbook until Saved in excel macro

[Scofield24]

Hi All,

I have created a workbook with multiple mandatory fields within it. What i wish is that all these fields must be filled before the workbook can be closed. For this i've tried 2 cases:-

Case 1: Using BeforeClose event in Macro

Problem with this is that user can leave the mandatory field blank and save it. Although he wont be able to close, but if he copies this saved workbook (by going to its location) to some other location(say) , he can use that copy as the original one.

Now you would think, why wouold he do that. Answer is i dont want to leave any loophole in this.


Case 2: Using BeforeSave event

Problem with this is that when a i try to close the sheet with some mandatory field blank, it will prompt me "Do you need to save the changes,etc" . If i click Yes, it will prompt (created by me) to fill the mandatory field , and then close. And the field would be blank, next time we open it.


So, How can i restrict the close until all the mandatory fields are filled and saved??


Appreciate your help.

I've also posted this thread on excelforum.com few days ago, but didnt got any solution yet.

Restricting close workbook until Saved in excel macro

Appreciate your help.

Thanks,
Scofield24

 

[royUK]

Is this what you want?

Option Explicit
Dim Start As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)


    Dim Rng1 As Range, Rng3 As Range, Rng4 As Range
    Dim Prompt As String, RngStr As String
    Dim Cell As Range
    'set your ranges here
    'Rng1 is on sheet "Group Profile" and cells B5 through B14
    'Cell F1, A range of F5 through F7 etc.  you can change these to
    'suit your needs.
    Set Rng1 = Sheets("Group Profile").Range("B5:B14,F1,F5:F7,B20:B22,B26:B31,B38:B45,B49:B52")
    Set Rng3 = Sheets("Eligibility Guidelines").Range("F1,E5,E6,E9,E10,B7:B17,B21:B36")
    Set Rng4 = Sheets("COBRA").Range("J2,H4,H5,J15,B4,B5,B9,B10:B13,B17:B20,B25:B28,E17:  E20")
    'message is returned if there are blank cells
    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 and have been highlighted yellow:" _
           & vbCrLf & vbCrLf
    Start = True
    'highlights the blank cells
    For Each Cell In Rng1
        If Cell.Value = vbNullString Then
            Cell.Interior.ColorIndex = 6    '** color yellow
            If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
            Start = False
            RngStr = RngStr & Cell.Address(False, False) & ", "
        Else
            Cell.Interior.ColorIndex = 0    '** no color
        End If
    Next
    If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
    Start = True
    If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
    For Each Cell In Rng3
        If Cell.Value = vbNullString Then
            Cell.Interior.ColorIndex = 6    '** color yellow
            If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
            Start = False
            RngStr = RngStr & Cell.Address(False, False) & ", "
        Else
            Cell.Interior.ColorIndex = 0    '** no color
        End If
    Next
    If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
    Start = True
    If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbCrLf
    For Each Cell In Rng4
        If Cell.Value = vbNullString Then
            Cell.Interior.ColorIndex = 6    '** color yellow
            If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
            Start = False
            RngStr = RngStr & Cell.Address(False, False) & ", "
        Else
            Cell.Interior.ColorIndex = 0    '** no color
        End If
    Next
    If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
    If RngStr <> "" Then
        MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
        Cancel = True
    Else
        Start = False
        'saves the changes before closing
        ThisWorkbook.Close True


    End If


    Set Rng1 = Nothing
    Set Rng3 = Nothing
    Set Rng4 = Nothing


End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Start
    MsgBox Me.Saved
End Sub

 

[Scofield24]

Hi royUK,

Thanks for your reply.

Can you tell me what this code is doing and how it is resolving the 2 cases and associated problems mentioned in my question?

Appreciate it.

Thanks,
Scofield

 

[royUK]

It stops saving unless the file has been checked for entries. I actually posted a reply at Oz to say that I think it might be better if you moved the check code.to another module then called it for each event.

 

[Scofield24]

umm...ok.. RoyUk! lets continue our discussion on Oz to avoid confusion. I also posted my concern with your solution there.

Thanks

 

[royUK]

I've replied at Oz because I can attach a workbook there.