I'm trying to write a short macro that will prevent the user of an excel workbook from closing the workbook without protecting the first sheet.
The code shows the message box but then proceeds to close the workbook. From my understanding, if the "Cancel" parameter is set to True, the workbook shouldn't close.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets(1).ProtectContents = True Then
Cancel = False
Else
MsgBox "Please Protect 'Unique Futures' Worksheet Before Closing Workbook"
Cancel = True
End If
End Sub
I just need the code to display the message box and then not close if the first sheet is not protected.
I could replicate it if I set Application.EnableEvents to False. In the below example I have remembered its state to place it back as was after, however, I'm not sure how it gets to a state of False to begin with.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim BlnEventState as Boolean
BlnEventState = Application.EnableEvents
Application.EnableEvents = True
If Sheets(1).ProtectContents = True Then
Cancel = False
Else
MsgBox "Please Protect 'Unique Futures' Worksheet Before Closing Workbook"
Cancel = True
End If
Application.EnableEvents = BlnEventState
End Sub
It may be a safer long term option to force the state rather then set it back.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = True
If Sheets(1).ProtectContents = True Then
Cancel = False
Else
MsgBox "Please Protect 'Unique Futures' Worksheet Before Closing Workbook"
Cancel = True
End If
End Sub
Related
I need some assistance with BeforeSave VBA event.
I've introduced an additional criteria using Conditional Formatting to highlight a cell if it does not equal 10 characters.
Issue is, I already have a BeforeSave event in VBA to check if a checkbox is checked, how can I combine these two statements so that it checks these two criteria before saving?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In Worksheets(1).UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
MsgBox ("Please correct any fields highlighted in red")
Exit For
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions before saving the Invoice"
End Sub
The highlighted criteria is the one I used to evaluate the checkbox, in between is the code I'm attempting to check for any cells filled in red. Also a sample in an excel sheet.
Thanks for the help!
You were close! A couple changes:
You need to check against the cell's .DisplayFormat since that is conditional formatting.
You were exiting your subroutine before getting to your If condition. Use Exit For instead.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
Cancel = True
Exit For
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions"
End Sub
Also Application.ScreenUpdating = True needs to be outside your loop, otherwise it may never be turned back on!
UPDATE:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In Worksheets(1).UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
MsgBox ("Please correct any fields highlighted in red")
Cancel = True
Application.ScreenUpdating = True
Exit Sub
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions before saving the Invoice"
End Sub
I'm trying to create a control that requires a user to enter information in a specific cell before they close the workbook. If the cell is empty when the users attempts to close then they should be prompted to either stay in the workbook and enter information or exit without saving. If the cell is populated then the workbook should automatically save itself.
Below is what I managed to come up with so far, placed in the ThisWorkbook object. The issue I'm having is that after the MsgBox appears and an option is selected, it then reappears a second time. I can't work out why this is happening so hopefully someone on here can point out what it is I'm missing.
Note, I only want the current active workbook to close, not the entire application to quit. So if the user has other Excel windows open I don't want those to get closed also.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Range(“A1”).Value = “” Then
OutPut = Msgbox (“A1 is empty. Exit without saving?”, vbOKCancel + vbDefaultButton2)
If OutPut = 1 Then
ThisWorkbook.Close False
Else: Cancel = True
Exit Sub
End If
End If
ActiveWorkbook.Save
End Sub
Well, you do try to close the workbook again using ThisWorkbook.Close False, that's where the second event originates from.
Instead, use ThisWorkbook.Saved = True to prevent the confirmation dialog to pop up:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim OutPut As VbMsgBoxResult
If Range("A1").Value = "" Then
OutPut = MsgBox("A1 is empty. Exit without saving?", vbOKCancel + vbDefaultButton2)
If OutPut = vbOK Then
ThisWorkbook.Saved = True
Else
Cancel = True
End If
Else
ThisWorkbook.Save
End If
End Sub
Big thanks to A.S.H for helping me with out with this code earlier.
Right now, I'm attempting to show a splash sheet that tells users to enable macros in order to access the workbook. The plan is to save the file with the splash sheet visible and other sheets veryhidden during the BeforeClose event. During the Open event, the splash sheet will be made veryhidden and the other sheets will be made visible.
Hence, the user will only see the splash sheet when he/she opens the file with macros disabled. However with the below code, it doesn't seem as though the routine that makes the splash sheet visible and the rest veryhidden is running. Where have I gone wrong?
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
Do
Ans = MsgBox("Do you want to save the changes you made to '" & _
Me.Name & "'?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
With rs
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.Value = Application.Trim(target.Value)
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
Cancel = True
r.Parent.Activate: r.Activate
MsgBox ("Please confirm all required fields have been completed")
Exit Sub
End If
Next
Application.ScreenUpdating = False
Sheets("Reminder").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVeryHidden
End If
Next ws
ActiveWorkbook.Save
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("Reminder").Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
Application.ScreenUpdating = True
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
Loop Until ThisWorkbook.Saved = True
End If
End Sub
If you are experiencing screen trouble, it is likely due to some erroneous manipulation of Application.ScreenUpdating here and in other macros. In this one, the error is that you first set it to False and then Exit Sub without restoring it to True.
Moreover, since your routine only does calculation (checking) and does not change cell values, there's no point in disabling Application.ScreenUpdating.
On a side note, I think your routine that checks for empty cells can be much simplified.
Function dataIsValid() As Boolean
Dim target As Range, r As Range
With ActiveSheet ' <-- May be better change to some explicit sheet name
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.value = Application.Trim(target.value) ' <-- trim the whole range
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
r.Parent.Activate: r.Activate ' <-- Show erroneous row
MsgBox ("Please confirm all required fields have been completed")
Exit Function
End If
Next
dataIsValid = True
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Question looks big but answer for you guys will be simple
I have code that works for first time and not working for second attempt.
I have 2 sheets "Menu" and "Subsheet"
Basically, i have data validation drop-down set on Menu Sheet yes/no values.
First scenario
Selecting "Yes" will enable the cells on second sheet (Subsheet)
Selecting "No" will disable cells on second sheet(Subsheet).
Second scenario,
User selecting "no" and selecting second sheet will throw a prompt for him to enable cells "ok" and cancel.
Select "ok" will enable cells and value in dropdown will be changed to "yes"
selecting "cancel" in msgprompt will disable cells and value in dropdown will remain "no"
Msg prompt should not be displayed, if user has selected "yes" in dropdown..
Question:Code works fine, until it comes to second scenario.
User selects "No" and selects second sheet in the message prompt, he selects "no". Now cells are disabled.
If user comes back to Menu Sheet and selects "Yes", will not enable cells.
Not sure what is it not enabling cells now. Please help
Code on Menu Sheet
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A11")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call uEnable
Case "NO"
Call uDisable
Exit Sub
End Select
Application.EnableEvents = True
End Sub
Code on SubSheet
Private Sub Worksheet_Activate()
UDisable
End Sub
Code on Module
Option Explicit
Private mMessageDisplayed As Boolean
Public Sub uDisable()
If ActiveSheet.ProtectContents And Not mMessageDisplayed Then
mMessageDisplayed = True
If ThisWorkbook.Sheets("Menu").Range("A11") = "NO" Then
If MsgBox("Cells are locked on current sheet, press ok to Unlock", vbOKCancel + vbInformation) = vbOK Then
ThisWorkbook.Worksheets("Menu").Range("A11") = "YES"
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = False
ActiveWorkbook.Unprotect Password:="xyz"
End With
Else
ThisWorkbook.Worksheets("Menu").Range("A11") = "NO"
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = True
ActiveWorkbook.Protect Password:="xyz"
End With
End If
Else
Exit Sub
End If
End If
End Sub
Second module
Public Sub uEnable()
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = False
ActiveWorkbook.Protect Password:="xyz"
End With
End Sub
I tried to use debug method, couldn't identify the root cause.
Two intersect codes
`Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E42")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim inputCell As Range
Set inputCell = Range("E43")
Select Case (Target.Value)
Case "Specific Days"
inputCell.Locked = False
inputCell.Activate
Case Else
'This handles **ANY** other value in the dropdown
inputCell.Locked = True
' inputCell.Clear
End Select
Application.EnableEvents = True
If Intersect(Target, Range("E29")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call Notify
Case "NO"
Call NotifyUserGeneral
End Select
Application.EnableEvents = True
End Sub`
Remove the Exit Sub from underneath Call uDisable. Otherwise Application.EnableEvents = True never gets called...
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call uEnable
Case "NO"
Call uDisable
'Exit Sub <---Can't do this.
End Select
Application.EnableEvents = True
End Sub
...and there isn't any other code that will turn them back on. You can't rely on an event handler to set Application.EnableEvents = True after you've turned off event handling.
I have Workbook with both Sheet/workbook is protected.
I have a code to lock/disable certain range of cells when the drop-down value "no" And unlock/enable when value of drop down is "yes"
Whereas, drop-down value and cells I would like to disable are on different sheets.
Dropdown on "Main Sheet"
Range of cells on "Sub Sheet"
I also need to throw a prompt to user when he clicks on protected range and when the value is set to "No".
I am using following code on "Main Sheet"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim str1 As String
If UCase$(Range("E30").Value) = "YES" Then
Sheets("SubSheet").Select
Sheets("SubSheet").Range("E20:I3019").Locked = False
Sheets("SubSheet").Range("E20:I3019").Activate
Else
Sheets("SubSheet").Range("E20:I3019").Locked = True
End If
End Sub
Following code on Sub Sheet
Private Sub WorkBook_SheetChange(ByVal sh as Object, ByVal Target as Range)
If Intersect (Target, sh.Range("$E$19:$I$3000")) Is Nothing Then Exit Sub
MsgBox "Please select the appropriate dropdown on MAIN Sheet " & Target.Address
With Application
.EnableEvents = False
.UnDo
.EnableEvents = True
End With
End Sub
Not sure, where am I going wrong as Its not throwing prompt when user clicks on protected cells.
First. You should remove the Sheets("SubSheet").Select. If you running your code and your are not inside the sheet, it could occur an error. try to do:
with ThisWorkbook.Sheets("SubSheet")
If UCase$(Range("E30").Value) = "YES" Then
.Range("E20:I3019").Locked = False
.Range("E20:I3019").Activate
Else
.Range("E20:I3019").Locked = True
End If
end with
Second. You don't return the target range. I mean your Private Sub WorkBook_SheetChange waits for a ByVal Target as a parameter and your Private Sub Worksheet_Change returns any value.It should be a function returning the range or the cell you have selected for me.
EDIT:
with ThisWorkbook.Sheets("SubSheet")
If UCase$(Range("E30").Value) = "YES" Then
.Range("E20:I3019").Locked = False
Else
.Range("E20:I3019").Locked = True
WorkBook_SheetChange Range("E20:I3019")
End If
end with
And
Private Sub WorkBook_SheetChange(ByVal Target as Range)
If Intersect (Target, Range("$E$19:$I$3000")) Is Nothing Then Exit Sub
MsgBox "Please select the appropriate dropdown on MAIN Sheet " & Target.Address
With Application
.EnableEvents = False
.UnDo
.EnableEvents = True
End With
End Sub