I have an Excel spreadsheet that needs most of it's cells protected from editing. I can't protect the sheet in the usual way because I work with groups (little + at the top to expand certain columns).
I found a VBA macro to protect my sheet, but noticed in Excel 2010 that I could simply "unprotect sheet" and modify everything, even though the whole workbook is still protected.
This is the macro I use at "ThisWorkbook":
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="nopassword"
If Range("C3").Value = "protect" Then
Range("C4:C65536").Locked = True
Else
Range("C4:C65536").Locked = False
End If
ActiveSheet.Protect Password:="fakepass"
End Sub
Private Sub Workbook_Open()
Dim x As Long
For x = 1 To ActiveWorkbook.Sheets.Count
With ActiveWorkbook.Sheets(x)
.Protect UserInterfaceOnly:=True
.EnableOutlining = True
End With
Next
End Sub
How can I modify this code to work with Sheet 1?
I'm aware it's not the safest form of protection but it's merely to prevent people modifying cells accidentally.
If you change:
ActiveSheet.Protect Password:="fakepass"
To:
Worksheets("Sheet1").Protect Password:="fakepass"
It will apply to Sheet1 rather than the active sheet only.
Or you could create a macro to protect all sheets, something like:
Sub ProtectAll()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:="fakepass", DrawingObjects:=True, Contents:=True, Scenarios:=True
Next ws
End Sub
And then call it into your main code?
ActiveSheet.Unprotect Password:="nopassword" Will only reference whatever sheet you're on.
Sheets("Sheet1").Activate will set active sheet to sheet1, no matter what sheet is selected.
Is that what you were after?
Related
I am trying to protect the headers in an Excel Spreadsheet. In order to do so, I selected the entire sheet, went to cell properties, and unchecked "locked". Then, I selected the first row only and checked "locked".
My macros run fine once, then on running again I get errors related to the sheets being locked, and when I go back and check my sheets, now ALL the cells are locked again. I do not have any VBA code specifying to lock any cells. I have this macro running to protect the sheets:
Public Sub ProtectSheet(Optional sheetname As String)
Dim thisSheet As Worksheet
'This is to protect sheet from userinterface, but not from macros
If IsMissing(sheetname) Then sheetname = ""
If sheetname = "" Then
Set thisSheet = ActiveWorkbook.ActiveSheet
Else
Set thisSheet = ActiveWorkbook.Worksheets(sheetname)
End If
thisSheet.Protect UserInterfaceOnly:=False, Contents:=True, DrawingObjects:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True, AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True
End Sub
I created VBA code as follows to unprotect the sheet, select all and unlock, then lock the first row, then protect. It works when I do this, but I don't understand why I have to.
Public Sub ProtectSheet(Optional sheetname As String)
Dim thisSheet As Worksheet
'This is to protect sheet from userinterface, but not from macros
If IsMissing(sheetname) Then sheetname = ""
If sheetname = "" Then
Set thisSheet = ActiveWorkbook.ActiveSheet
Else
Set thisSheet = ActiveWorkbook.Worksheets(sheetname)
End If
thisSheet.Unprotect
thisSheet.Cells.Locked = False
thisSheet.Rows(1).Locked = True
thisSheet.Protect UserInterfaceOnly:=False, Contents:=True, DrawingObjects:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True, AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True
End Sub
I want to understand WHY all my cells are locking and would prefer not to have to add this extra code in when I don't believe I should have to. Is there a bug in Excel causing the locked property to get set, or I am missing something in this code that is locking them automatically?
If the problem is use of Clear then consider creating a separate sub to manage that, and call it instead of Clear.
Sub ClearButUnlocked(rng As Range)
with rng
.clear
.cells.locked=false
end with
end sub
...assuming rng only has one lock state and is not a mix of locked/unlocked cells
I Have created a data entry form in excel using VBA , I want to protect te database sheet to have manual entry but to allow save the data , edit the data and delete the data or row via vba userform.
I have coded the below written to protect the sheet.
Sub Workbook_Open()
Worksheets("Database").Protect Password:=True, UserinterfaceOnly:=True
End Sub
It is working fine but after some time it is giving me run time error 1004.
Along with this it is not allowing me to delete the previous data using delete button
When you edit sheet even through with a VBA userform, sheet needs to temporarily unprotected. You can do it like this:
' Unprotect
Sheets("SHEET").Unprotect password:="PASSWORD"
'
'your code here
'
' Protect
Sheets("SHEET").protect password:="PASSWORD"
Delete Rows on Protected Worksheet
If you are prepared to unlock entire rows, then you could prepare the worksheet with something like the following code.
It is not to be used in the Workbook_Open event code; it is just some code to prepare the worksheet.
Note AllowDeletingRows:=True.
But, you cannot delete a row if all of the cells are not unlocked.
The issue with rows (similarly with columns) is that if you delete one, the next row 'lands in the spot' of the deleted one. So e.g. if after using the example code the user deletes any of the allowed rows, than he wouldn't be able to delete row 50 which might just be the behavior that you require.
The Code
Option Explicit
' Remove this Sub when done.
Sub Allowed()
Const AllowedRows As String = "2:50"
Const pWord As String = "123"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database")
With ws
.Unprotect pWord
.Cells.Locked = True ' Lock all cells.
.EnableSelection = xlNoRestrictions
.Rows(AllowedRows).Locked = False ' Unlock allowd rows.
.Protect Password:=pWord, DrawingObjects:=True, Contents:=True, _
Scenarios:=True, AllowDeletingRows:=True
End With
End Sub
I have a workbook with multiple sheets that needs all non-blank cells to be locked and protected when opening the workbook.
This will be an employee training record where multiple trainers will be evaluating new staff on skills. I would like to prevent anyone from accidentally deleting training data.
I found a code that will lock all cells, set all blank cells as unlocked, and protect the individual worksheet, but I'm having trouble applying this across my entire workbook.
Private Sub Workbook_Open()
Dim myCell As Range
Set myCell = Selection
Cells.Select
Selection.Locked = True
myCell.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Locked = False
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
myCell.Select
End Sub
Ideally, I would also like to add password protection to prevent a new employee from unprotecting the workbook. Is this possible within the same code? Can split this to a new question also.
In this case the password for each sheet is secret:
Sub Tony()
Dim s As Worksheet
For Each s In Sheets
s.Unprotect ("secret")
s.Cells.Locked = False
On Error Resume Next
s.Cells.SpecialCells(xlCellTypeConstants).Locked = True
s.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
On Error GoTo 0
s.Protect ("secret")
Next s
End Sub
NOTE:
First make sure this does what you want. Only then have your event macro call it.
I know there are lots of questions on this, which I have read - but none seem to give me the code I need to make this work.
I have a number of buttons that I have placed in the Ribbon of my excel sheet. These are attached to macros that copy sheets onto another sheet, as an example
The macro is ran by pressing the button:
Sub btnSheet1_onAction(control As IRibbonControl)
mFunction.CopySheet1toSheet2
End Sub
The macro is contained in my mFunction module as :
Public Sub CopySheet1toSheet2()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
ws.Cells.Copy Destination:=ThisWorkbook.Sheets(2).Cells
End Sub
Now.... I need to protect items/cells in sheet 1 and 2. When I protect the sheets the macros make excel crash - no runtime errors or anything.
I have inserted the following code into the 'ThisWorkbook'
Private Sub Workbook_Open()
Sheets(1).Protect Password:="secret", UserInterFaceOnly:=True
Sheets(2).Protect Password:="secret", UserInterFaceOnly:=True
End Sub
But it still doesn't work - I have also tried with the following code in the mFunction module
Public Sub CopySheet1toSheet2()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
ws.Unprotect Password = "secret"
ws.Cells.Copy Destination:=ThisWorkbook.Sheets(2).Cells
ws.Protect Password = "secret"
End Sub
But that doesn't seem to work either - I am guessing it might be something to do with the fact that the macro is copying the sheet into another sheet that is locked also?
I should also note that there are other sheets in the workbook that are protected, but that do not have macros attached to them, so they stay protected, could this be causing an issue?
Some help would be greatly appreciated!!
UserInterFaceOnly
When you save a Workbook with sheets that have been protected using UserInterFaceOnly, this property is removed on the file that is saved. So on reopening the file the sheets will remain protected but can not be changed programmatically either.
So, regarding this piece of code, which on first glance appears to do exactly what you need:
Private Sub Workbook_Open()
Sheets(1).Protect Password:="secret", UserInterFaceOnly:=True
Sheets(2).Protect Password:="secret", UserInterFaceOnly:=True
End Sub
.. if you save and reopen your file, when your above Workbook_Open() runs it will fail to set the protection as there is already protection in place.
The workaround is to include lines for each sheet that remove any protection in place first. Then you can set it again correctly - like so:
Private Sub Workbook_Open()
Sheets(1).Unprotect Password:="secret"
Sheets(2).Unprotect Password:="secret"
Sheets(1).Protect Password:="secret", UserInterFaceOnly:=True
Sheets(2).Protect Password:="secret", UserInterFaceOnly:=True
End Sub
This should then allow your copy code to run without issue as I can't see much wrong with that part at all.
Incidentally, if your passwords are the same, you could tidy it up slightly with:
Private Sub Workbook_Open()
Dim sh As Worksheet
For Each sh In Array(Sheets(1), Sheets(2))
sh.Unprotect Password:="secret"
sh.Protect Password:="secret", UserInterFaceOnly:=True
Next
End Sub
Okay - so I have used this as a work around, but if anyone can give a more eloquent solution that would be great:
Dim ws As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
ws1.Unprotect ("2402")
ws2.Unprotect ("2402")
ws1.Cells.Copy Destination:=ws2.Cells
ws1.Protect ("2402")
ws2.Protect ("2402")
Like many other people, I want to be able to enable grouping and ungrouping with the little +/- buttons on a protected worksheet. Everyone seems to have succeeded with the same sort of code that protects the worksheet, enables outlining and then unprotects it again, which is great and it works except if I save the sheet and then re-open it again EnableOutlining is always set as False, and if the sheet is protected I cannot use the +/- buttons. Is there something else I am supposed to do to save this setting permanently, and not just for the duration of the session?
Here's the code I have been using:
Private Sub Workbook_Open()
MsgBox ActiveSheet.EnableOutlining
End Sub
Sub EnableOutliningWithProtection_AllSheets()
'PURPOSE: Allow Outline functionality during Protection in all Sheets
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
'(Except edited by me to include the Errorcatch)
Dim sht As Worksheet
On Error GoTo Errorcatch
'Loop through each Worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
'Password Protect Current Sheet
sht.Protect Password:="", UserInterfaceOnly:=True
'Enable Group Collapse/Expand Capabilities
sht.EnableOutlining = True
'Unprotect Sheet
sht.Unprotect ""
Next sht
Exit Sub
Errorcatch:
MsgBox Err.Description
End Sub
(I've got the Workbook_Open() bit to check if EnableOutlining was still True)
I've seen the 'protect UserInterfaceOnly and EnableOutlining' question, but I didn't think the results applied as the code was written for C#, and I'm not looking at protecting UserInterfaceOnly.
You can't save it permanently. You have to use the Open event to reset it when the workbook is opened.
Private Sub Workbook_Open()
EnableOutliningWithProtection_AllSheets
End Sub