This code makes the entire sheet read only.
I want to make cells which are empty (hold null value) read only. It should work for different Excel files where the used cell range could be different.
Sub proFirst()
Sheets("DCAFTE").UsedRange.Select
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
Dim myRange As Range
Set myRange = ActiveSheet.UsedRange
myRange.Select
Selection.Locked = True
ActiveSheet.Protect Contents:=True
End Sub
You can replace your code with the below code. This will select only the cells which are empty (blank) and make it read only. The cells which are having values will be editable.
Sub proFirst()
Sheets("DCAFTE").Select
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
Dim myCell As Range
Set myCell = Selection
Cells.Select
Selection.Locked = False
myCell.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Locked = True
ActiveSheet.Protect Contents:=True
myCell.Select
End Sub
Related
I have a workbook with VBA code which copies a template sheet but I want to protect certain cells from editing when copied. The template sheet is protected by the locked cells which needs to be locked, but some cells are for user input and should be unlocked.
I cant get it to lock the cells in the copied sheet.
Sub MyCopySheet()
Dim myNewSheetName
myNewSheetName = InputBox("Enter Today's Date")
Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName
Sheets(Sheets.Count - 1).Activate
Cells.Copy
Sheets(myNewSheetName).Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F5:F69").ClearContents
Range("G5:G69").ClearContents
Range("H5:H69").ClearContents
Range("I5:I69").ClearContents
Range("J5:J69").ClearContents
Range("K5:K69").ClearContents
Range("Q5:Q59").ClearContents
Range("O5:O59").ClearContents
Range("L5:L69").ClearContents
Range("B23:B27").ClearContents
Range("B59:B63").ClearContents
Range("B32:B36").ClearContents
Range("B78:B94").ClearContents
Range("C78:C94").ClearContents
Range("F78:F94").ClearContents
Range("G78:G94").ClearContents
Range("J78:J94").ClearContents
Range("I78:I94").ClearContents
Range("K78:K94").ClearContents
Range("L78:L94").ClearContents
Range("B50:B54").ClearContents
End Sub
Sub lockcells()
Dim Rng
Dim MyCell
Set Rng = Range("A1:Q96")
For Each MyCell In Rng
If MyCell.Value = "" Then
Else: ActiveSheet.Unprotect Password:="password"
MyCell.Locked = True
MyCell.FormulaHidden = False
ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True
End If
Next
End Sub
Basically all the cells with Range().ClearContent must be unlocked and the rest locked.
Sub MyCopySheet()
Dim myNewSheetName
myNewSheetName = InputBox("Enter Today's Date")
Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName
Sheets(Sheets.Count - 1).Activate
Cells.Copy
Sheets(myNewSheetName).Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'clear contents
Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").ClearContents
End Sub
I reduced your code to clear contents. And below, the code to unprotect cells from range where you cleared contents
Sub lockcells()
Dim Rng
Dim MyCell
Set Rng = Range("A1:Q96")
For Each MyCell In Rng
If MyCell.Value = "" Then
Else: ActiveSheet.Unprotect Password:="password"
MyCell.Locked = True
MyCell.FormulaHidden = False
ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True
End If
Next
'now we unprotect the range we cleared contents
Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").Locked = False
End Sub
I have managed to assemble the following code for spell checking a locked document but just cant quit get it to work. I would like it to look at only unlocked cells but still use the 'CommandBars("Tools").Controls("Spelling...").Execute' function. Any ideas would be great. TIA
Sub SelectUnlockedCells_Spellcheck()
ActiveSheet.Unprotect Password:=""
Dim WorkRange As Range
Dim FoundCells As Range
Dim Cell As Range
Set WorkRange = ActiveSheet.UsedRange
For Each Cell In WorkRange
If Cell.Locked = False Then
If FoundCells Is Nothing Then
Set FoundCells = Cell
Else
Set FoundCells = Union(FoundCells, Cell)
End If
End If
Next Cell
If FoundCells Is Nothing Then
MsgBox "All cells are locked."
Else
FoundCells.CheckSpelling CommandBars("Tools").Controls("Spelling...").Execute
End If
ActiveSheet.Protect Password:=""
End Sub
You are using this code
FoundCells.CheckSpelling CommandBars("Tools").Controls("Spelling...").Execute
But the VBA help doesn't show any such parameters. Try using just this:
FoundCells.CheckSpelling
I am trying to write a macro that will lock any cell greater than 0. When I run the code below it works but locks the 1st row where I have a drop down arrow that does sorting and number filters. Is there a way to add to this code so that the first row wont be locked?
Sub Test()
Dim Cell As Range
Dim MyPlage As Range
With ThisWorkbook.ActiveSheet
.Unprotect
.Cells.Locked = False
Set MyPlage = .Range("J2:AA1074")
For Each Cell In MyPlage
If Not IsError(Cell) Then
If Cell.Value > "0" Then
Cell.Locked = True
End If
End If
Next
.Protect
End With
End Sub
The most simplest was is to define your range which doesn't include the Top Row :)
Change
.Range("J2:AA1074")
to
.Range("J3:AA1074")
Also, Instead of looping through every cell in the range and checking if that cell has an error or not, you can directly use SpecialCells. For example (TRIED AND TESTED)
Sub Sample()
Dim Cell As Range, MyPlage As Range, FinalRange As Range
With ThisWorkbook.ActiveSheet
.Unprotect
.Cells.Locked = False
On Error Resume Next
Set MyPlage = .Range("J3:AA1074").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not MyPlage Is Nothing Then
For Each Cell In MyPlage
If Cell.Value > 0 Then Cell.Locked = True
Next
End If
.Protect DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowSorting:=True
.EnableSelection = xlUnlockedCells
End With
End Sub
To ensure that Autofilter and Sorting works, specify it in .Protect as I have done above.
Before you run the above code, you also need to take one extra step.
Unprotect the worksheet if it is already protected
Under Review Tab, click on "Allow Users to Edit Ranges"
Add "New" range
Select the range you want allow users to sort
Screenshot
You can add following code to the Sheet module (change Range("J1:AA1") to the range with your autofilter):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("J1:AA1")) Is Nothing Then
ActiveSheet.Protect
Else
ActiveSheet.Unprotect
End If
End Sub
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.
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