I have applied this macro to protect and unprotect in given range of cells in a sheet here is a problem i am facing in this macro When I run this macro this macro is protecting in given range of cells A1 to D20 and when I am run again this macro to unprotect in given range it's not unprotecting
Sub lockcells()
Dim Rng
Dim MyCell
Set Rng = Range("A1:D20")
For Each MyCell In Rng
If MyCell.Value = "" Then
Else: ActiveSheet.UnProtect Password:="123"
MyCell.Locked = True
MyCell.FormulaHidden = False
ActiveSheet.Protect Password:="123", UserInterFaceOnly:=True
End If
Next
End Sub
I want to protect and unprotect with single macro
CodePudding user response:
Unlock Cells and Hide Their Formulas
- You should consider using
If Not IsEmpty(sCell)
to additionally lock the cells containing formulas (that will be hidden) evaluating to""
. It makes more sense to me. Think about it.
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Locks the non-blank cells in a range and hides their formulas.
' Remarks: First it unlocks all cells and unhides their formulas.
' Then, if previously all cells were unlocked, it locks
' the non-blank cells and hides their formulas.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ToggleLockCells()
On Error GoTo ClearError
Dim ws As Worksheet: Set ws = Sheet1
Dim srg As Range: Set srg = ws.Range("A1:D20")
Dim trg As Range
Dim sCell As Range
' Test if no cell is locked.
If Not IsAnyCellLocked(srg) Then ' no locked cells
For Each sCell In srg.Cells
' 'Blank' ...
If Len(CStr(sCell.Value)) > 0 Then
' ... or 'Empty' to also lock cells with formulas evaluating to ""
'If Not IsEmpty(sCell) Then '
Set trg = GetCombinedRange(trg, sCell)
End If
Next
'Else ' at least one cell is locked
End If
Application.ScreenUpdating = False
If ws.ProtectContents Then
ws.Unprotect Password:="123"
End If
' Unlock the whole range anyway.
srg.Locked = False
srg.FormulaHidden = False
If Not trg Is Nothing Then
trg.FormulaHidden = True
trg.Locked = True
MsgBox "Range locked.", vbInformation, "Lock Cells in Range"
Else
MsgBox "Range unlocked.", vbExclamation, "Lock Cells in Range"
End If
SafeExit:
If Not ws.ProtectContents Then
ws.Protect Password:="123", UserInterFaceOnly:=True
End If
Application.ScreenUpdating = True
Exit Sub
ClearError:
Debug.Print "Run'time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Checks if at least one of the cells in a range is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsAnyCellLocked( _
ByVal srg As Range) _
As Boolean
If srg Is Nothing Then Exit Function
Dim sCell As Range
For Each sCell In srg.Cells
If sCell.Locked Then
IsAnyCellLocked = True
Exit For
End If
Next sCell
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the range combined from two ranges.
' Remarks: An error will occur if 'AddRange' is 'Nothing'
' or if the ranges are in different worksheets.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetCombinedRange( _
ByVal CombinedRange As Range, _
ByVal AddRange As Range) _
As Range
If CombinedRange Is Nothing Then
Set GetCombinedRange = AddRange
Else
Set GetCombinedRange = Union(CombinedRange, AddRange)
End If
End Function
CodePudding user response:
Some small adjustment to make it "protect/unprotect". I made the assumption that you only want to protect/lock a cell if it's not empty.
Option Explicit
Sub lockcells()
Dim Rng As Range
Dim MyCell As Object
Set Rng = Range("A1:D20") 'Set range to lock cells
If ActiveSheet.ProtectContents = True Then 'Check if sheet is protected
ActiveSheet.Unprotect Password:="123" 'Password to unprotect
Else
For Each MyCell In Rng
If MyCell.Value <> "" Then 'If cell is empty, if not empty lock the cell
MyCell.Locked = True 'Lock cell
MyCell.FormulaHidden = False 'Don't hide formulas
End If
Next MyCell
ActiveSheet.Protect Password:="123", UserInterFaceOnly:=True 'Protect Sheet
End If
End Sub
If you want all cells to be editable except a range you can add the following code:
'Else
ActiveSheet.Cells.Locked = False
ActiveSheet.Cells.FormulaHidden = False
'For Each MyCell In Rng
This will make only Range("A1:D20")
protected with password. All other cells is free to be editable.