Workbook_BeforeClose() is not preventing user to close even when specific ranges are blank

[arijitirf]

Hi!
I am using Excel LTSC 2021
I want a code so that user cannot Save as well as Close Excel file until specific range in Sheet is not filled (User cannot Save the file also cannot close the file if any given range is left blank)

Below is the that I have found in other site but the excel file is getting closed without fulfilling the criteria after popping up msgbox. Aslo popping up msgbox even if the criteria is met.

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("B2,G2,B3,F3,I1:I3,C4,D5,D6:D22")
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


Any help would be highly appreciated. Apologies for not sharing the file or XL2BB due IT Policy of my organization.

 

[John_w]

I want a code so that user cannot Save as well as Close Excel file until specific range in Sheet is not filled

You mean until the specific range is filled?

You need Workbook_BeforeClose and Workbook_BeforeSave in the ThisWorkbook module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)    
    If Required_Cells_Are_Complete = False Then
        Cancel = True
    End If    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)    
    If ThisWorkbook.Saved = False Then
        If Required_Cells_Are_Complete = False Then
            Cancel = True
        End If
    End If
End Sub

Code in a standard module:

Public Function Required_Cells_Are_Complete() As Boolean

    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Prompt As String
    Dim Cell As Range
    
    Set Rng1 = Worksheets("Daily Centre Inputs").Range("B2,G2,B3,F3,I1:I3,C4,D5,D6:D22")
    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
    
    Required_Cells_Are_Complete = True
    For Each Cell In Rng1
        If Cell.Value = vbNullString Then
            Prompt = Prompt & Cell.Address(False, False) & vbCrLf
            Required_Cells_Are_Complete = False
            If Rng2 Is Nothing Then
                Set Rng2 = Cell
            Else
                Set Rng2 = Union(Rng2, Cell)
            End If
        End If
    Next
    
    If Not Required_Cells_Are_Complete Then
        MsgBox Prompt, vbCritical, "Incomplete Data"
        Rng2.Select
    End If

End Function

 

[6StringJazzer]

It worked fine for me.

Dropbox

www.dropbox.com

 

[arijitirf]

You mean until the specific range is filled?

You need Workbook_BeforeClose and Workbook_BeforeSave in the ThisWorkbook module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)   
    If Required_Cells_Are_Complete = False Then
        Cancel = True
    End If   
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)   
    If ThisWorkbook.Saved = False Then
        If Required_Cells_Are_Complete = False Then
            Cancel = True
        End If
    End If
End Sub

Code in a standard module:

Public Function Required_Cells_Are_Complete() As Boolean

    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Prompt As String
    Dim Cell As Range
   
    Set Rng1 = Worksheets("Daily Centre Inputs").Range("B2,G2,B3,F3,I1:I3,C4,D5,D6:D22")
    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
   
    Required_Cells_Are_Complete = True
    For Each Cell In Rng1
        If Cell.Value = vbNullString Then
            Prompt = Prompt & Cell.Address(False, False) & vbCrLf
            Required_Cells_Are_Complete = False
            If Rng2 Is Nothing Then
                Set Rng2 = Cell
            Else
                Set Rng2 = Union(Rng2, Cell)
            End If
        End If
    Next
   
    If Not Required_Cells_Are_Complete Then
        MsgBox Prompt, vbCritical, "Incomplete Data"
        Rng2.Select
    End If

End Function

Apologies for late come back.

Tried the above code and I faced one issue, when user wnat to close by clicking "X" button, leaving any one or more than one specific cell Blank, msgbox appears to inform about the left out cell and clicking ok it is asking Do you want to save and pressing Yes again msgbox appears and by clicking ok excel file is getting closed.

I want user to fill all the mandatory fields otherwise saving option will not pop up even user tries to close it or it will alert user by another msgbox "Data Cannot be saved."

Than you for taking interest on the issue.

 

[John_w]

Tried the above code and I faced one issue, when user wnat to close by clicking "X" button, leaving any one or more than one specific cell Blank, msgbox appears to inform about the left out cell and clicking ok it is asking Do you want to save and pressing Yes again msgbox appears and by clicking ok excel file is getting closed.

The part in bold doesn't happen for me. When I click the X close button and any of the required cells are blank the "Incomplete Data" message is displayed. Clicking OK it selects the required cell(s) which are empty. No other prompt is displayed.

When I click the X close button or Save the workbook and any of the required cells are blank the "Incomplete Data" message is always displayed. The workbook is closed or saved only when all the required cells are completed.