Is there a way to prevent Excel from closing if cell B34 > 0 and J34 = 0?
If they leave B34 alone then J34 doesn't need to be filled in and the workbook can close.
If they enter data into B34 we need info in J34 as well.
Something like this:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Application.Sheets("Sheet1").Range("B34").Value > "" and _
Application.Sheets("Sheet1").Range("B34").Value = "" Then
Cancel = True
MsgBox "Please fill in the total % in cell J34"
End If
End Sub
In the ThisWorkbook object:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
If ws.Range("B34").Value <> "" And ws.Range("J34").Value = "" Then
Cancel = True
MsgBox "Please fill in the total % in cell J34"
End If
End Sub
Related
I have protected sheets 4 with a password because there are some cells that users aren't allowed to input in those cells in sheet 4. The password is 1234.
But, I want to run my macro, and if there is an error, the cell will be highlight automatically.
My macro doesn't run and error, because the cell that I want to highlight is in protected sheet.
How to make the sheet 4 stay protected and make my macro keep running when I click the validation button?
Private Sub commandbutton1_click()
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=1234, WriteResPassword:=1234, _
ReadOnlyRecommended:=False, CreateBackup:=False
vehicle = Sheets("4").Range("K22")
expenditure_gasoline = Sheets("4").Range("M22")
If vehicle = true and expenditure_gasoline = 0 Then
MsgBox "it should not be empty", vbcritical
End If
If vehicle = true and expenditure_gasoline = 0 Then Sheets("4").Range("M22").Interior.ColorIndex = 3
End sub
Try the changes bellow (untested)
V1 - Protect the sheet from user changes, but not VBA changes UserInterfaceOnly:=True
Option Explicit
Private Sub commandbutton1_click()
Const PATH_AND_FILENAME = "C:\YourTestFile.xlsx" '<------ Update this path & file name
Dim wb As Workbook, ws As Worksheet, vehicle As Variant, expenditureGasoline As Variant
Set wb = Workbooks.Open(Filename:=PATH_AND_FILENAME, WriteResPassword:="1234", _
Password:="1234", Format:=xlOpenXMLWorkbookMacroEnabled)
Set ws = wb.Sheets("4")
ws.Protect Password:="1234", UserInterfaceOnly:=True '<--- Protect changes from UI only
Set vehicle = ws.Range("K22")
Set expenditureGasoline = ws.Range("M22")
If Not IsError(vehicle) And Not IsError(expenditureGasoline) Then
If vehicle = True And expenditureGasoline = 0 Then
ws.Range("M22").Interior.ColorIndex = 3
MsgBox "Cell M22 should not be empty", vbExclamation
End If
End If
End Sub
V2 - Unprotect before the change, and Protect back after the change
Private Sub commandbutton1_click()
Const PATH_AND_FILENAME = "C:\YourTestFile.xlsx" '<------ Update this path & file name
Dim wb As Workbook, ws As Worksheet, vehicle As Variant, expenditureGasoline As Variant
Set wb = Workbooks.Open(Filename:=PATH_AND_FILENAME, WriteResPassword:="1234", _
Password:="1234", Format:=xlOpenXMLWorkbookMacroEnabled)
Set ws = wb.Sheets("4")
Set vehicle = ws.Range("K22")
Set expenditureGasoline = ws.Range("M22")
If Not IsError(vehicle) And Not IsError(expenditureGasoline) Then
If vehicle = True And expenditureGasoline = 0 Then
ws.Unprotect "1234" '<--- Unprotect it before the change
ws.Range("M22").Interior.ColorIndex = 3
ws.Protect "1234" '<--- Protect it back, after the change
MsgBox "Cell M22 should not be empty", vbExclamation
End If
End If
End Sub
I am trying to automatically lock cells after user has hit save button. The sheets is protected and contains some unlocked cells where user can input data.
Now I want those cells to get locked after user has clicked data. I have multiple sheets in the workbook but I want this to happen just for the first sheet.
Option Explicit
Dim Ws As Worksheet
Private bRangeEdited As Boolean
'Private WithEvents Ws As Worksheet
Private Sub Workbook_Open()
Set Ws = Range("A1:ZZ27").Parent
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "Beim Speichern der Arbeitsmappe werden die Eingabezellen gesperrt. " & vbLf
sMSG = sMSG & "Möchten Sie fortfahren ?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
With Range("A1:ZZ27")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
Unpro_SheeTS
' .Parent.Unprotect "1234"
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
Pro_SheeTS
' .Parent.Protect "1234"
End With
End If
Xit:
End Sub
Private Sub ws_Change(ByVal Target As Range)
Dim Ws As Worksheet
If Not Intersect(Range("A1:ZZ27"), Target) Is Nothing Then
bRangeEdited = True
End
End Sub
Sub Unpro_SheeTS()
For Each Ws In ActiveWorkbook.Worksheets
Ws.Unprotect ("1234")
Next
Exit Sub
End Sub
Sub Pro_SheeTS()
For Each Ws In ActiveWorkbook.Worksheets
Ws.Protect ("1234")
Next
Exit Sub
End Sub
My guess is that you should have a worksheet_change event function which keeps track of what cell is modified in a list/array/collection as you feel.
On the other hand your Workbook_BeforeSave event would go through the sheets you want and for each of them it would unprotect the sheet, lock the cells (worksheet.range(...).locked = true) then protects the sheet.
(You dont need to protect the workbook for your purpose, it is a different matter)
for you to have better results :
indent your code
refer to ranges from a worksheet explicitly
(worksheet.range)
consider migrating to another language ;)
I'm looking for a way to write into another sheet in excel, every time someone either protects or unprotects the sheet in my Workbook. I want it to log whether it was protected or unprotected and the time beside it. Thanks!
Right now I have the following code for protecting or unprotecting the sheet with a more user friendly button:
If ActiveWorkbook.Sheets("Calendar").ProtectContents = True Then
ActiveSheet.Unprotect
MsgBox "Sheet unprotected"
Exit Sub
End If
ActiveSheet.Protect ("password")
MsgBox "Calendar has been protected"
Excel VBA does not have an event that can detect if a sheet is being protected/unprotected.
Don't shoot the messenger.
A google would have landed you here: https://www.ozgrid.com/forum/index.php?thread/43816-unprotect-worksheet-event/, the author even gives you a sample:
https://www.ozgrid.com/forum/core/index.php?attachment/1082834-52719-xls/
This is not 100% fool proof as the eventhandler can not tell when a user Cancels the protect/unprotect dialog.
This workbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StartEventListiner False
End Sub
Private Sub Workbook_Open()
StartEventListiner True
End Sub
Module
Option Explicit
Public g_clsEvnt As CProtectEvt
Public Sub StartEventListiner(Action As Boolean)
If Action Then
Set g_clsEvnt = New CProtectEvt
Else
Set g_clsEvnt = Nothing
End If
End Sub
Class
Option Explicit
Public WithEvents cbbProtect As CommandBarButton
Private Sub m_ProtectControls(State As Boolean)
Dim objX As OLEObject
On Error Resume Next
For Each objX In ActiveSheet.OLEObjects
objX.Object.Enabled = State
Next
End Sub
Private Sub cbbProtect_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
m_ProtectControls (InStr(1, Ctrl.Caption, "Un&protect", vbTextCompare) > 0)
End Sub
Private Sub Class_Initialize()
On Error Resume Next
' hook into Tools > Protection > Protect Sheet event
Set cbbProtect = Application.CommandBars.FindControl(msoControlButton, ID:=893)
End Sub
Toggle and Log Worksheet Protection
The code only logs the protection when using the button (which has toggleWorksheetProtection_Click assigned to it) or when running toggleWorksheetProtection_Click from VBE.
Copy the complete code into a standard module (e.g. Module11).
Adjust the values of the five constants.
ThisWorkbook refers to the workbook containing this code.
Additionally adjust the date format in writeLogRow.
The Code
Option Explicit
Sub toggleWorksheetProtection_Click()
' Constants
Const srcName As String = "Calendar"
Const tgtName As String = "Log"
Const tgtCol As Variant = 1
Const msgProtect As String = "Sheet protected."
Const msgUnProtect As String = "Sheet unprotected."
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Other Variables
Dim src As Worksheet: Set src = wb.Worksheets(srcName)
Dim tgt As Worksheet: Set tgt = wb.Worksheets(tgtName)
Dim msg As String
' Protection
If src.ProtectContents Then
src.Unprotect: msg = msgUnProtect
Else
src.Protect: msg = msgProtect
End If
' Log
Dim cel As Range
Set cel = getEmptyCell(tgt, tgtCol)
writeLogRow cel, msg
End Sub
Function getEmptyCell(Sheet As Worksheet, ByVal writeColumn As Variant)
Dim cel As Range
Set cel = Sheet.Columns(writeColumn).Find("*", , xlValues, , , xlPrevious)
If Not cel Is Nothing Then
Set cel = cel.Offset(1)
Else
Set cel = Sheet.Cells(1, writeColumn)
End If
Set getEmptyCell = cel
End Function
Sub writeLogRow(logRange As Range, ByVal logMessage As String)
Dim logDate As Date: logDate = Now
logRange.Value = logDate
logRange.NumberFormat = "mm/dd/yyyy hh:mm:ss (ddd)"
logRange.Offset(, 1).Value = logMessage
End Sub
I have the sub "ProtectAllSheets" in Module1 and another one on Sheet1 object, which is meant to delete the whole rows if there is a #REF! Error in column C of Sheet1. It works fine when the sheet is protected... BUT somehow when I close the workbook and open it again(Which is still protected) it doesn't delete the rows with Errors eventhough it is "UserInterface=True". If I unprotect the sheet, it works fine. It seems like as soon as I close the workbook some information is lost "somehow"... I just cannot grasp what the hell could be wrong with the code.
Option Explicit
Public pwd1 As String, pwd2 As String
Sub ProtectAllSheets()
Dim ws As Worksheet
pwd1 = InputBox("Enter your password", "")
If pwd1 = "" Then Exit Sub
pwd2 = InputBox("Enter the password again", "")
If pwd2 = "" Then Exit Sub
'Checks if both the passwords are identical
If InStr(1, pwd2, pwd1, 0) = 0 Or _
InStr(1, pwd1, pwd2, 0) = 0 Then
MsgBox "Please type the same password. ", vbInformation, ""
Exit Sub
End If
For Each ws In ActiveWorkbook.Sheets
If ws.ProtectContents = False = True Then
ws.Protect Password:=pwd1, UserInterFaceOnly:=True
End If
Next ws
MsgBox "Sheets are protected."
End Sub
Option Explicit
Sub Worksheet_Activate()
Dim sh As Worksheet
Dim c As Long
Set sh = ActiveSheet
For c = 400 To 2 Step -1
If IsError(Cells(c, 3)) Then
Rows(c).EntireRow.Delete
End If
Next c
End Sub
Ok Folks, for those of you who may have a similar problem.
I know is not the best solution but it works. It seems like the UserInterFaceOnly feature is not being saved in the file, as soon as you close and reopen the workbook, it is gone. So, this is what I did.
Step 1. Deleted Sub ProtectAllSheets ()
Step 2. Inserted A Workbook_Open procedure.
Now... someone can still see the pasword "1214" if they hit Alt+F11. I just can't do much about it.
Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If Not ws.ProtectContents Then
ws.Protect Password:=1214, UserInterFaceOnly:=True
End If
Next ws
MsgBox "Sheets are protected."
End Sub
Step 3. Kept the same Sub by Worksheet_Activate ()
Sub Worksheet_Activate()
Dim sh As Worksheet
Dim c As Long
Set sh = ActiveSheet
For c = 400 To 2 Step -1
If IsError(Cells(c, 3)) Then
Rows(c).EntireRow.Delete
End If
Next c
End Sub
I have done 2 separate prog till now.
One displays a message box before closing a workbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim answer As String
Dim question As String
question = "Display all the sheets which are Unprotected"
answer = MsgBox(question, vbYesNo)
If answer = vbNo Then
MsgBox "complete everything and then close"
Cancel = True
Exit Sub
Else
ThisWorkbook.Save
End If
End Sub
Another displays in a new sheet "Unprotected", list of all the unprotected sheets.
Sub UnprotectSheet()
Dim ws As Worksheet, a As Range
ActiveWorkbook.Worksheets.Add.Name = "Unprotected"
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = False And ws.Name <> "Unprotected" Then
CNT = Sheets("Unprotected").Cells(Sheets("Unprotected").Rows.Count, "A").End(xlUp).Row
Sheets("Unprotected").Cells(CNT + 1, "A") = ws.Name
End If
Next
End Sub
I want a Message box to appear if I try to close the worksheet and if any sheet is unprotected, the message box displays the names of the unprotected sheets. I am facing problem in combining the above 2 codes.
I am not a VBA expert and I am trying it but unable to solve it.
Something like this can show you a list of the unprotected sheets. However, it's probably better to just use VBA to force their protection, rather than prompting the user to do it (unless they need to provide a password for protection status).
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim answer As String
Dim question As String
Dim unprotected as String
unprotected = GetUnprotectedSheets(ThisWorkbook)
If unprotected <> vbNullString Then
MsgBox "Please protected the following worksheets before closing" & vbCRLF & unprotected
Cancel = True
Exit Sub
Else
ThisWorkbook.Save
End If
End Sub
Function GetUnprotectedSheets(wb as Workbook)
'Custom function to return a string of sheet names
' which are unprotected
Dim ret as String
Dim ws as Worksheet
For each ws in wb.Worksheets
If Not ws.ProtectContents Then
ret = IIF(ret = "", ws.Name, ret & vbCRLF & ws.Name)
End If
Next
GetUnprotectedSheets = ret
End Function
You can call a procedure like this to ensure all sheets are protected:
Sub ProtectAllSheets(wb as Workbook)
Dim ws as Worksheet
For each ws in wb.Worksheets
If Not ws.ProtectContents Then ws.Protect
Next
End Sub
Just add a counter to your second script:
Sub UnprotectSheet()
Dim ws As Worksheet, a As Range
Dim iCounter As Integer, strMessage As String 'Adding a counter variable & string
'ActiveWorkbook.Worksheets.Add.Name = "Unprotected"
iCounter = 0 'Initialize it
strMessage = "" 'Initialize empty string for the message box
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = False Then
iCounter = iCounter + 1 'Keeping track of any unprotected sheet
' CNT = Sheets("Unprotected").Cells(Sheets("Unprotected").Rows.Count, "A").End(xlUp).Row
' Sheets("Unprotected").Cells(CNT + 1, "A") = ws.Name
strMessage = strMessage & ws.Name & " "
End If
Next
' Here you can do your msgbox or any other action if unprotected sheet detected
If iCounter > 0 Then
MsgBox ("These sheets are unprotected: " & strMessage)
End If
End Sub
EDIT:
To enclose that within a button click: add an activeX button to your form, then:
Private Sub CommandButton1_Click()
'E.g. make the sub a commmandbutton_click() event
End Sub
Actually, when you add the button to your form, if you right-click on it you have the option "View code" - this will create an associated Commandbutton_click like I showed above.