VBA to protect and unprotect in given range in sheet

2
votes

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

2
excelvba

2 Answers

0
votes

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
0
votes

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.