I am generating a Daily Planner Sheet in which i want to lock some appraisal cells after saving. I have written the following code in excel workbook code. The macro asks to enter password before saving. Why is it asking to enter the password?(I have 53 sheets for weekly planning. I have shown only 2 here)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Sheet18").Unprotect Password:="****"
Sheets("Sheet19").Unprotect Password:="****"
ActiveSheet.Protect Contents:=False
For Each Cell In Range("H5:H24,J5:J24")
If Cell <> "" Then Cell.Locked = True
If Cell = "" Then Cell.Locked = False
Next
ActiveSheet.Protect Contents:=True
Sheets("Sheet18").Protect Password:="****"
Sheets("Sheet18").Protect UserInterfaceOnly:=True
Sheets("Sheet19").Protect Password:="****"
Sheets("Sheet19").Protect UserInterfaceOnly:=True
End Sub
Your code will behave differently depending on the active sheet when saving.
Additionnaly, I wouldn't recommend to overload the reserved name "Cell" with a local loop variable. This will lead to unexpected behavior.
You should remove references to ActiveSheet.
If your wish is to protect the entire workbook, I would suggest iteration over the worksheets:
Sub ProtectAll()
Dim wSheet As Worksheet
Dim myCell As Range
For Each wSheet In Worksheets
wSheet.Unprotect Password:="****"
For Each myCell In Range("H5:H24,J5:J24")
myCell.Locked = (myCell <> "")
Next myCell
wSheet.Protect Contents:=True, Password:="****", UserInterfaceOnly:=True
Next wSheet
End Sub
NB: you have to put the code in a code module.
Related
On a protected user form (table with data) I have found a possibility to allow sorting protected cells by unprotecting the header row when selected (if...then) and protecting the sheet whenever another cell(s) is selected (else). So now, when clicking the header row and clicking the filter symbol, users can sort, because in this moment the file is unprotected.
Now, there is one problem remaining: when users select data in the databodyrange (or any other cell that is not in header row (here: row 11)) and then directly click on the filter symbol in the header row for sorting, they have activated cells that cause the sheet to protect (Else) and to unprotect (If...then) at the same time.
So the code itsself works fine. What I struggle with is writing an error handling, that for example on error selects a cell in the header row and continues to run the macro in all funcionality + doesn't disturb the user.
What is an easy Error Handling for the following code?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
If (Target.Row = 11) Then 'Row 11 is the tables header's row
With Ws
.Unprotect ""
End With
Else
With Ws
.EnableAutoFilter = True
.EnableOutlining = True
.Protect "", contents:=True, UserInterfaceonly:=True, AllowFormattingRows:=True, AllowFiltering:=True, AllowSorting:=True
End With
End If
End Sub
Thanks - and really just an error handling is looked for. No other workaround!
I solved my own issue using On Error Resume Next. It is not super elegant, but this way users are able to "sort on a protected sheet with locked cells".
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
On Error Resume Next
If Err.Number <> 0 Then
Application.Undo
MsgBox "Please select a cell in the header row, before sorting or filtering."
End If
If (Target.Row = 11) Then
With Ws
.Unprotect ""
End With
Else
With Ws
.EnableAutoFilter = True
.EnableOutlining = True
.Protect "", contents:=True, UserInterfaceonly:=True, AllowFormattingRows:=True, AllowFiltering:=True, AllowSorting:=True
End With
End If
End Sub
I don't know very much at all about VBA, but I found the below code on a website and am using it in a workbook.
Private Sub Workbook_Open()
With Worksheets("WFD")
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
How should I amend this so that if the Sheet name is changed from "WFD" to something else, the code still works? Also I would like it to apply to all sheets in the workbook.
Thanks very much
If you want this code for each worksheet use code below:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
Next
End Sub
You should use the Sheet Object Codename.
This is found in the VB Editor beside the sheet objects in the VB project.
By default they are Sheet1, Sheet2 etc. You can easily change them by clicking and typing a new name etc.
You could of course leave them as default codeName if you like...
This is NOT the same as the worksheet name, which is changed by users on the Sheet tabs in Excel interface.
Private Sub Workbook_Open()
With WFD 'where WFD is the CODENAME of the Sheet Object!
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
You could write Worksheets(1) or Worksheets(5), depending on the number of the Worksheet. However, if you start adding and deleting Worksheets, it whould not work (e.g., it would be working on some other worksheet). To see the associated number to the worksheet, run this and check the immediate window:
Option Explicit
Public Sub TestMe()
Dim ws As Worksheet
Dim cnt As Long
For cnt = 1 To ThisWorkbook.Worksheets.Count
Debug.Print cnt; "-> "; Worksheets(cnt).name
Next cnt
End Sub
However, if you have only one Worksheet, Worksheets(1) would always work.
I am very new to VBA and have basically taught myself while building my current Excel 'contract'. My goal is have a list of contract options which are shown or hidden depending on their representative check boxes. There are 12 total options with ranges that I show/remove across 4 worksheets.
In terms of organization, I have utilized modules based on each action. I also named all my ranges
Prior to me protecting my worksheet, when I select a checkbox, all 4 ranges across all 4 worksheets immediately show. When I unselect, they immediately clear their contents and hide. Yay!
Once I protect my worksheet, however, things either slow down to a crawl or I get an error. In my ProtectWorksheet module below, the commented out lines work, but from reading other stack overflow articles it seens better to use the code I have. Unprotected, it works great. Protected I get the "Error 1004': Unable to set the Hidden property of the Range class". If I instead use my commented out code while protected, it works but is super slow.
Technically I can get everything to work...but from a user interface stance it's terrible.
Below is the 1st contract option I have been testing. Please and thank you for any and all help!
under the Excel Objects - sheet2(Data Input)
Private Sub chkDomesticHotWater_Click()
ProtectOFF
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If chkDomesticHotWater = True Then
AddDomesticHotWater
Else
'Remove the lines, clear the data, and move the mouse to the top
RemoveDomesticHotWater
ClearDomesticHotWater
Range("A1").Select
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ProtectON
End Sub
under the Module: Checkboxes
Sub AddDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = False
[Contract_DomesticHotWater].EntireRow.Hidden = False
[Invoice_DomesticHotWater].EntireRow.Hidden = False
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = False
End Sub
Sub RemoveDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = True
[Contract_DomesticHotWater].EntireRow.Hidden = True
[Invoice_DomesticHotWater].EntireRow.Hidden = True
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = True
End Sub
Under the Module ClearData
Sub ClearDomesticHotWater()
Range("DataInput_DomesticHotWater").Select
For Each cell In Selection
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
Range("DomesticHotWaterStart").Select
End Sub
under the Module ProtectWorksheet
Sub ProtectON()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Protect Password:=pwd, UserInterfaceOnly:=True
Next ws
'Worksheets("Data Input").Protect Password:="123"
'Worksheets("Contract").Protect Password:="123"
'Worksheets("Invoice").Protect Password:="123"
'Worksheets("Expected Cost").Protect Password:="123"
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Unprotect Password:=pwd
Next ws
'Worksheets("Data Input").Unprotect Password:="123"
'Worksheets("Contract").Unprotect Password:="123"
'Worksheets("Invoice").Unprotect Password:="123"
'Worksheets("Expected Cost").Unprotect Password:="123"
End Sub
EDIT
I was able to speed it up just a tiny bit by updating my Protect On/Off code below, but it's still a 3-5 second delay when I click on my check boxes:
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123"
Next
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Unprotect Password:="123"
Next
End Sub
EDIT - SOLUTION?
So I don't think this is best practice, nor have I really 'solved' my delay, but I found a workaround. I eliminated the delay when clicking my check boxes by turning on protection yet allowing row formatting. Technically my sheet is no longer 100% protected from user tinkering, but I think that risk is worth removing such an annoying wait time after clicking.
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123", AllowFormattingRows:=True
Next
End Sub
It should not be that slow, although I really have no clue how fast is your PC and how big is the data. However, here is something you can make better:
Sub ClearDomesticHotWater()
For Each cell In [DataInput_DomesticHotWater]
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
End Sub
and remove all selects, they are slowing you down. Go around them like this:
How to avoid using Select in Excel VBA macros
I have a work book with several worksheets that I would like to protect. I am not using a password on the protection. I have some visual basic code associated with this sheet to expand the row width on merged cells. The code will not work when the sheets are protected.
I did find some guidance on adding unprotect code to my code, but can't figure out where to put it and how to address the fact that there is no passord. Further guidance woudl be greatly appreciated!
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub
You could probably do something like this:
Surround your code with .Unprotect and .Protect
Sub protectSheet()
Dim ws As Worksheet
Set ws = Sheets(1)
With ws
.Unprotect "password"
'Insert Code Here
.Protect "password"
End With
End Sub
try this:
Private Sub Workbook_Open()
Dim wSheet As Worksheet
For Each wSheet In Worksheets
wSheet.Protect Password:="Password_here", _
UserInterFaceOnly:=True
Next wSheet
End Sub
Put this code in 'ThisWorkbook' then use the Workbook_Open Event.
This code protects all the WS everytime you open the WB
but allows macro to run due to UserInterfaceOnly set to true
You need to protect the sheet with password.
If you want a user to edit some cells even if the worksheet is protected then set the locked property of those cells to false before protecting the sheet.
Now when Worksheet_Change is triggered or any procedure is called which is trying to make some changes to excel range (locked cells = true) then you need to Unprotect the Sheet at beginning of the code and protect it at the end again. You may refer #sobin answer for syntax.
Also you may use error handlers and explicitly protect the sheet. This is done to avoid situation wherein the sheet is unprotected and then there is error which comes up for any reason then that would leave the sheets unprotected.
I'm trying to loop through a range of cells, locking any cell that has content while leaving empty cells unlocked.
When I run the below code the result is the entire sheet is locked. If I add an else statement the sheet is unlocked. Basically whatever the last .locked = (true, false) statement is is how the entire sheet winds up.
Change 1 Is it possible that I have some setting on/off that is interfering since I'm the only one who is unable to get any of this to work?
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
'Clear the default status
ActiveSheet.Unprotect
Range("A7:I35").Locked = False
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
If chCell.Value <> "" Then Cells.Locked = True
Next chCell
ActiveSheet.Protect
End Sub
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
ActiveSheet.Unprotect
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
chCell.Locked = (chCell.Value <> "")
Next chCell
ActiveSheet.Protect
End Sub
You can try this.
Public Sub abc()
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("I8:I500, K8:K500, M8:M500, N8:N500").Cells.Locked = False
ActiveSheet.Protect Password:="1234"
End Sub
Check this out: http://www.mrexcel.com/archive/VBA/15950b.html
Sub CellLocker()
Cells.Select
' unlock all the cells
Selection.Locked = false
' next, select the cells (or range) that you want to make read only,
' here I used simply A1
Range("A1").Select
' lock those cells
Selection.Locked = true
' now we need to protect the sheet to restrict access to the cells.
' I protected only the contents you can add whatever you want
ActiveSheet.Protect DrawingObjects:=false, Contents:=true, Scenarios:=false
End Sub
If you say Range("A1").Select, then it locks only A1. You can specify multiple cells to be locked by specifying as follows:
A3:A12,D3:E12,J1:R13,W18
This locks A3 to A12 and D3 to E12 etc.
I may be missing something but...
Cells.Locked = True
...will lock all cells on the active sheet. If you just change it to...
chCell.Locked = True
...then it works; I think?! As the range is very small, you may as well not unlock cells at the start, and instead unlock cells whilst locking them e.g.
For Each chCell In chRng.Cells
If chCell.Value <> "" Then
chCell.Locked = True
Else
chCell.Locked = False
End If
Next chCell
If you are new to VBA, I would recommend cycling through code line-by-line as described in this Excel consultant's video. If you step through code, you can check "has cell A7 behaved as expected?"...instead of just seeing the end product
A quick way to unlock non-blank cells is to use SpecialCells see below.
On my testing this code handles merged cells ok, I think this is what is generating your error on Tim's code when it looks to handle each cell individually (which to be clear is not an issue in Tim's code, it is dealing with an unexpected outcome)
You may also find this article of mine A fast method for determining the unlocked cell range useful
Sub Quicktest()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlFormulas)
Set rng2 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlConstants)
On Error GoTo 0
ActiveSheet.Unprotect
ActiveSheet.Range("A7:I35").Cells.Locked = False
If Not rng1 Is Nothing Then rng1.Cells.Locked = True
If Not rng2 Is Nothing Then rng2.Cells.Locked = True
ActiveSheet.Protect
End Sub
I know this is an old thread, but I've been stuck on this for a while too, and after some testing on Excel 2013 here's what I conclude if your range includes any merged cell
The merged cells must be entirely included within that range (e.g. the merging must be entirely within the range being lock/unlocked
The range being merged can be larger, or at least exactly the range corresponding to the merged cells. If it's a named range that works as well.
Also, you cannot lock/unlock a cell that is already within a protected range. E.g if you run:
public sub test()
Sheet1.range("myNameRange").locked = true
Sheet1.protect
end sub
Twice it will work the first time, and fail the second time around. So you should unprotect the target range (or the sheet) before....
If you want to protect the specific cells of any specific excel without the password protection then here is the solution:
Sub ProtectingSheet()
Workbooks.Open (c\documents\....)
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
Worksheets(CellValue).Activate
mainworkBook.Sheets("Sheet1").Range("A1:AA100").Locked = True
Range(Cells(1, 2), Cells(1, 25)).Select
Selection.Locked = False
ActiveSheet.Protect
End Sub