Solved: Alter Code To Allow Spread Sheet To Close

[BENSON]

The code below works fine, it does not allow a user to close the spread sheet untill specific data has been entered.I would like to modify the code so the the user can close the spread sheet if they choose, after the message box advises them of the in complete data (I will change the message box information )

Thanks
[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
Application.ScreenUpdating = False
For Each wSheet In Worksheets



Next



Dim Arr, Dy As Long
Dim Rng As Range, cell As Range
Dim Start As Boolean
Dim Prompt As String, RngStr As String

Prompt = "PLEASE CHECK YOUR DATA ENSURING ALL REQUIRED " & _
"CELLS ARE COMPLETE." & vbCrLf & "YOU WILL NOT BE ABLE " & _
"TO CLOSE OR SAVE THE DAILY REPORT UNTIL ALL THE REQUIRED CELLS ARE FILLED " & _
"OUT COMPLETELY. " & vbCrLf & vbCrLf & _
"THE CELLS LISTED BELOW CONTAIN NO DATA AND HAVE BEEN HIGHLIGHTED RED:" _
& vbCrLf & vbCrLf

Arr = Array("TUES", "WED", "THURS", "FRI", "SAT", "SUN", "MON")
For Dy = 0 To Weekday(Now, vbTuesday) - 1
With Worksheets(Format(Weekday(Date), "ddd"))
Start = True
Set Rng = TgtRange(.Name)
'highlights the blank cells
For Each cell In Rng
If cell.Value = vbNullString Then
cell.Interior.ColorIndex = 3 '** color red
If Start Then RngStr = RngStr & cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & cell.Address(False, False) & " , "
Else
cell.Interior.ColorIndex = 36 '** Light Yellow
End If
Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 0)
End With
Next
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If

For Each wSheet In Worksheets

Next
Application.ScreenUpdating = True
End Sub
[/VBA]

[grichey]

switch to a yes no msgbox

maybe like
[VBA]Dim response As VbMsgBoxResult

response = MsgBox("Save without closing?", vbQuestion + vbYesNo)
If response = vbYes Then
ActiveWorkbook.Close False

End If[/VBA]

[rory]

Change your MsgBox line to something like:
[VBA] response = MsgBox(prompt & rngstr & vbCrLf & "Do you really wish to close?", vbCritical + vbYesNo, "Incomplete Data")
Cancel = (response = vbNo)
[/VBA]

[BENSON]

Not to sure where to insert the suggested code lines

[Bob Phillips]

Like so

[vba]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
Application.ScreenUpdating = False
For Each wSheet In Worksheets



Next



Dim Arr, Dy As Long
Dim Rng As Range, cell As Range
Dim Start As Boolean
Dim Prompt As String, RngStr As String

Prompt = "PLEASE CHECK YOUR DATA ENSURING ALL REQUIRED " & _
"CELLS ARE COMPLETE." & vbCrLf & "YOU WILL NOT BE ABLE " & _
"TO CLOSE OR SAVE THE DAILY REPORT UNTIL ALL THE REQUIRED CELLS ARE FILLED " & _
"OUT COMPLETELY. " & vbCrLf & vbCrLf & _
"THE CELLS LISTED BELOW CONTAIN NO DATA AND HAVE BEEN HIGHLIGHTED RED:" _
& vbCrLf & vbCrLf

Arr = Array("TUES", "WED", "THURS", "FRI", "SAT", "SUN", "MON")
For Dy = 0 To Weekday(Now, vbTuesday) - 1
With Worksheets(Format(Weekday(Date), "ddd"))
Start = True
Set Rng = TgtRange(.Name)
'highlights the blank cells
For Each cell In Rng
If cell.Value = vbNullString Then
cell.Interior.ColorIndex = 3 '** color red
If Start Then RngStr = RngStr & cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & cell.Address(False, False) & " , "
Else
cell.Interior.ColorIndex = 36 '** Light Yellow
End If
Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 0)
End With
Next
If RngStr <> "" Then
response = MsgBox(prompt & rngstr & vbCrLf & "Do you really wish to close?", vbCritical + vbYesNo, "Incomplete Data")
Cancel = (response = vbNo)
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If

For Each wSheet In Worksheets

Next
Application.ScreenUpdating = True
End Sub
[/vba]