Closing workbook/application when cells contain certain text.

[Frncis]

I have VBA code that prevents closing the workbook/application with the red X, or going to another work sheet if a cell range contains RED or Yellow. The code does work as expected. However, there is one problem, that I did not foresee. It also prevents you from closing the application. The code is based on Cell range F4: F17 containing "No". I am wondering if it is possible to modify the code, so the user can't move on to another worksheet, but can exit, and leave the color filled cells, filled? This cell range for closure would be Cell range F4: F17 containing "No".
I have included both the code to fill the cells & to prevent the closure due to filled cells. So you have an idea of the entire code.

Here is the code to fill the cells:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'This code fills a certain cell range with either Red or Yellow.
Dim rngToTest As Range
    Dim rngCel As Range
    Dim lngColor As Long
   
    On Error GoTo ReEnableEvents
    Application.EnableEvents = False
   
    lngColor = RGB(255, 0, 0)  'Edit the RGB code if required
    lngColor = RGB(255, 255, 0)  'Edit the RGB code if required
 
    'Test if the string "Meeting" appears in the worksheet name.
    If InStr(1, Sh.Name, "Meeting", vbTextCompare) > 0 Then
        With Sh
            Set rngToTest = .Range("B4:P17") 'Edit the range if required.
         
                        For Each rngCel In rngToTest
                If rngCel.DisplayFormat.Interior.Color = lngColor Then
                    Application.Goto rngCel
                    MsgBox " Cannot exit worksheet while any cells are highlighted in Red or Yellow" & vbCrLf _
                                & "Please complete appropriate cells.", vbExclamation, Title:="Voc. Rehab - Career Link Data Entry"
                        GoTo ReEnableEvents
                End If
            Next rngCel
        End With
    End If
   
ReEnableEvents:
    If Err.Number <> 0 Then
        MsgBox "An error occurred in ThisWorkbook module, Private Sub Workbook_SheetDeactivate"
    End If
   
    Application.EnableEvents = True
End Sub

Here is the code to prevent closure & going to another worksheet:
This part of the code is located in This workbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Part of code to call a pop up calendar.
  On Error Resume Next
          Application.OnKey "+^{C}"
    Application.CommandBars("Cell").Controls("Insert Date").Delete
    'Prevents closure by clicking on the Red X.
    Cancel = Not ok2Close
End Sub

Part 2 of the code is located in module 1:

Public ok2Close As Boolean

Sub OVR_MEETING_1_Close()
'This code does the following tasks.

  '1.  Asks if you want the application closed.
     
  '2.  Returns the application to the home page (If yes).

  '3.  Does any final calculations & saves (If Yes).

  '4.  Closes both the work book & the application (if yes).

Dim Msg As String, Ans As Variant
   
    Msg = "Would you like to close Career Link meeting List?"
   
    Ans = MsgBox(Msg, vbYesNo, "Voc. Rehab - Career Link Data Entry")
   
    Select Case Ans
       
    Case vbYes
        Dim i As Long
   
    Application.ScreenUpdating = False
   
    For i = 1 To ThisWorkbook.Sheets.Count
        Application.Goto Reference:=Sheets(i).Range("A1"), Scroll:=True
    Next i
   
    Application.ScreenUpdating = True

    Sheets("TOC").Select
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.Close SaveChanges:=True
  ok2Close = True
  Application.Quit
End Select
End Sub

I have Googeled to as of now, I have not found anything close to solving this problem.

 

[Chihiro]

Without sample and how exactly you want the workbook to behave. It's bit hard to help.

However, why not add custom button or control that overrides close procedure and takes over closing of application?

 

[Frncis]

Without sample and how exactly you want the workbook to behave. It's bit hard to help.

However, why not add custom button or control that overrides close procedure and takes over closing of application?

Here is a sample that you can work with:

https://1drv.ms/x/s!Ak-4iXjPpsJMgQIcY3XrTunX8HJ7

I am trying to allow a user to exit if "No" is found in F4:F17or "Yes" is found in H4:H17.
Currently if either is answer is found in the ranges It goes in a loop that you can't break, except by using task manager. So you can't fix your mistake, or exit.

 

[Chihiro]

So this happens when you hit "Exit" button?

This is due to the fact you are looping through each sheet in the workbook in OVR_MEETING_1_CLOSE sub, and also looping through sheets on Workbook_SheetDeactivate.

So if any sheet contain "Red" or "Yellow" cell color, in specified range. It will display that message repeatedly, due to double loop operation.

Is there a particular reason you are looping through each sheet on both modules/subs?

 

[Frncis]

So this happens when you hit "Exit" button?

This is due to the fact you are looping through each sheet in the workbook in OVR_MEETING_1_CLOSE sub, and also looping through sheets on Workbook_SheetDeactivate.

So if any sheet contain "Red" or "Yellow" cell color, in specified range. It will display that message repeatedly, due to double loop operation.

Is there a particular reason you are looping through each sheet on both modules/subs?

yes My error. Thanks for pointing this out. I will work on correcting this. However I still classify my self as a beginner regarding code.

Thank you for the easy fix. I made the change & it works even better that what I expected.

 

[Chihiro]

You are welcome