Workbook_BeforeClose event

[sanilmathews]

Hi, I am looking for some help in modifying the below code.
Present Situation: Below code will not allow the user to close the workbook unless Rng1 is filled out.

Requirement: The below code should be modified in a way that if all cells in the range are blank, user can close the workbook. However if "any one" cell in the range is not blank, user should not be allowed to close the workbook unless all cells in the range is filled.

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 ("Sheet1").Range ("B4:F4, B5, C13:C14, C17:C22, C24:C25")
Prompt = "Please ensure to fill all fields"
For Each Cell In Rng1
If Cell.Value = vbNullString Then
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

Thanks

 

[dmt32]

Hi
Try following & see if does what you want

Thisworkbook Code page

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cancel = NotAllowClose(Worksheets("Sheet1"))
End Sub

Standard module

Function NotAllowClose(ByVal sh As Object) As Boolean
    Dim Rng1 As Range, Cell As Range
    Dim Prompt As String
    
    Prompt = "Please ensure to fill all fields"
    
    Set Rng1 = sh.Range("B4:F4, B5, C13:C14, C17:C22, C24:C25")
    
    With Application
        NotAllowClose = CBool(.CountA(Rng1) > 0 And .CountA(Rng1) <> Rng1.Cells.Count)
    End With
    
    If NotAllowClose Then
    sh.Activate
    For Each Cell In Rng1.Cells
       If Len(Cell.Value) = 0 Then Cell.Select: Exit For
    Next Cell
        MsgBox Prompt, vbCritical, "Incomplete Data"
    End If
End Function

Dave

 

[sanilmathews]

Hi Dave, This works perfectly fine. Thank you

 

[dmt32]

Hi Dave, This works perfectly fine. Thank you

most welcome - many thanks for feedback

Dave