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.
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 macro that unlocks my excel document, spellchecks, then locks the worksheet. However, upon locking the worksheet, it removes the rules regarding what a user can do in the locked spreadsheet (ex: add/delete rows, change box height/width, etc)
I've tried listing out the rules after .Protect Password but it doesn't work.
Sub ProtectSheetCheckSpellCheck()
'Update by Extendoffice 2018/11/2
Dim xRg As Range
On Error Resume Next
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect ("Password123")
Set xRg = .UsedRange
xRg.CheckSpelling
.Protect Password:="Password123", AllowInsertingRows:=True, AllowInsertingColumns:=True
End With
Application.ScreenUpdating = True
End Sub
What you are looking for is being able to modify your worksheet without actually unprotecting it.
You can protect a sheet but allow VBA to make changes, whilst the user cannot:
ActiveSheet.Protect UserInterfaceOnly:=True
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.protect
Name: UserInterfaceOnly
Description: True to protect the user interface, but not macros. If this argument is omitted, protection applies both to macros and to the user interface.
This assumes the option was set to True when the sheet was protected in the first place.
Alternatively, you can store the status of the current protection settings in a Protection object:
Dim myProtection as Protection
Set myProtection = ActiveSheet.Protection
Which would look like this:
Note that for some reasons .AllowEditRanges return an error when read so I did not include it in the list.
Sub test()
'Pick your Worksheet
Dim mySheet As Worksheet
Set mySheet = ActiveSheet
'Unprotect it
Dim myProtection As Protection
Set myProtection = mySheet.Protection
mySheet.Unprotect
'Do your VBA things
'Re Protect it
With myProtection
mySheet.Protect AllowFormattingCells:=.AllowFormattingCells, _
AllowFormattingColumns:=.AllowFormattingColumns, _
AllowFormattingRows:=.AllowFormattingRows, _
AllowInsertingColumns:=.AllowInsertingColumns, _
AllowInsertingRows:=.AllowInsertingRows, _
AllowInsertingHyperlinks:=.AllowInsertingHyperlinks, _
AllowDeletingColumns:=.AllowDeletingColumns, _
AllowDeletingRows:=.AllowDeletingRows, _
AllowSorting:=.AllowSorting, _
AllowFiltering:=.AllowFiltering, _
AllowUsingPivotTables:=.AllowUsingPivotTables
End With
End Sub
Note: .Protect includes [DrawingObjects], [Scenarios], and [USerInterfaceOnly], whilst these settings are not provided by the Protection object. I understand the [Contents] parameter should relate to the .AllowEditRanges, but since it cannot be acessed I guess it will be skipped too,
I need to update many old 2003 .xls files to lock and protect a block of cells to keep people from opening the cells and copying out the header information. This is a one-time process, unfortunately, I can't just block off\restrict access to the files.
Using Excel 2010 in compatibility mode I have cobbled together a macro that opens the files, locks the cells, protects the worksheets, then saves and closes the file and moves on to the next file. However, when I manually re-open the files I am still able to copy from the locked cells. Worksheet is showing as protected, when I unlock the cells they show as locked AND they show select locked cells is checked. Any ideas?
Sub Lockdown()
Dim wBk As Workbook
Dim sFileSpec As String
Dim sPathSpec As String
Dim sFoundFile As String
sPathSpec = "C:\Archive\PF\"
sFileSpec = "*.xls"
sFoundFile = Dir(sPathSpec & sFileSpec)
Do While sFoundFile <> ""
Set wBk = Workbooks.Open(sPathSpec & sFoundFile)
With wBk
Application.DisplayAlerts = False
For Each ws In Worksheets
ws.Unprotect 'Some worksheets have protection without password
ws.Unprotect Password:="A1234" 'some worksheets have password protection
ws.Range("A1:I10").Locked = True
ws.Protect contents:=True
Next
Application.DisplayAlerts = True
End With
Set wBk = Nothing
Workbooks(sFoundFile).Close True
sFoundFile = Dir
Loop
End Sub
Thanks for any help!
Below is an example I put together that will prevent the user from selecting ONLY the cells A1, A2, B1, and B2. However, all other cells can be selected.
Set myWkbk = ActiveWorkbook
Set mySht = myWkbk.Worksheets(1)
With mySht
.Cells.Locked = False
.Range("A1:B2").Locked = True
.Protect contents:=True
.EnableSelection = xlUnlockedCells
End With
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?