Lock and Unlock Sheets based on Cell values

**Mujahid_Sgd** · 01-31-2011, 05:52 AM

Hi All,

I have an excel workbook in which there are three sheets, each sheet has two cells which I have named as Sheet1!Sign1, Sheet1!Sign2.... Sheet3!Sign2.

What I intend to do is to lock the sheet whenever the signature cells are filled in for a particular sheet.

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)

    
Dim NamesList
Dim x As Integer
Dim SignStatus1, SignStatus2 As Boolean
    
For x = 1 To ActiveWorkbook.Worksheets.Count
    For y = 1 To ActiveWorkbook.Worksheets(x).Names.Count
        NamesList = ActiveWorkbook.Worksheets(x).Names(y).Name
        If InStr(1, NamesList, "Sign1", vbTextCompare) <> 0 And ActiveWorkbook.Worksheets(x).Names(NamesList).Value = 0 Then
                
                SignStatus1 = False
        Else
               'ActiveWorkbook.Worksheets(x).Range(NamesList).Locked = False
                SignStatus1 = True
        End If
        
        If InStr(1, NamesList, "Sign2", vbTextCompare) <> 0 And ActiveWorkbook.Worksheets(x).Names(NamesList).Value = 0 Then
                SignStatus2 = False
        Else
                'ActiveWorkbook.Worksheets(x).Range(NamesList).Locked = False
                SignStatus2 = True
        End If
    Next y
    
        If SignStatus1 = True And SignStatus2 = True Then
            ActiveWorkbook.Worksheets(x).Protect
        Else
            ActiveWorkbook.Worksheets(x).Unprotect
        End If
Next x

The overall intention is that when someone fills in the signature cells the sheet gets locked or protected and whenever the signs are deleted only then data can be edited

With the code above the sheet gets protected but I want to leave the sign cells unprotected.

Two commented lines in the code return an error

Unable to set the locked property of range class to locked

Can someone please help

Thanks

Mujahid

**DonkeyOte** · 01-31-2011, 10:32 AM

If you need to be able to clear Sign1 & Sign2 then those cells must always remain Unlocked irrespective of sheet protection - on which basis perhaps you want something like:

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim rngS As Range
    Const C_PWD = "Password"
    Select Case UCase(sh.Name)
        Case "SHEET1", "SHEET2", "SHEET3"
            sh.Unprotect C_PWD
            Set rngS = Union(sh.Range("Sign1"), sh.Range("Sign2"))
            rngS.Locked = False
            If Not Intersect(Target, rngS) Is Nothing Then
                If Application.CountA(rngS) = rngS.Cells.Count Then sh.Protect C_PWD
            End If
            Set rngS = Nothing
    End Select
End Sub

so the above will always leave Sign1 & Sign2 unlocked and will protect the sheet only where both Sign1 & Sign2 have been populated.

modify variables / references as necessary

**Mujahid_Sgd** · 02-01-2011, 05:11 AM

Thanks for the reply..
and thanks for the help.. the code works beautifully..

Just wondering if this code can be extended to n number of sheets.

**Mujahid_Sgd** · 02-01-2011, 05:19 AM

I tried this and it seems to be working

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim rngS As Range
    Const C_PWD = "locked"
    Select Case (sh.Index)
        Case 1 To ActiveWorkbook.Worksheets.Count
            sh.Unprotect C_PWD
            Set rngS = Union(sh.Range("Sign1"), sh.Range("Sign2"))
            rngS.Locked = False
            If Not Intersect(Target, rngS) Is Nothing Then
                If Application.CountA(rngS) = rngS.Cells.Count Then sh.Protect C_PWD
            End If
            Set rngS = Nothing
    End Select
End Sub

**DonkeyOte** · 02-01-2011, 05:21 AM

Originally Posted by Mujahid_Sgd

Just wondering if this code can be extended to n number of sheets.

if "n" is determined by simply however many sheets have both Sign1 & Sign2 ranges then it might be simplest to make this requirement the pre-emptive test:

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim rngS As Range
    Const C_PWD = "Password"
    If [ISREF(Sign1)+ISREF(Sign2)] = 2 Then
        sh.Unprotect C_PWD
        Set rngS = Union(sh.Range("Sign1"), sh.Range("Sign2"))
        rngS.Locked = False
        If Not Intersect(Target, rngS) Is Nothing Then
            If Application.CountA(rngS) = rngS.Cells.Count Then sh.Protect C_PWD
        End If
        Set rngS = Nothing
    End If
End Sub

or

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim rngS As Range
    Const C_PWD = "Password"
    On Error Resume Next
    Set rngS = Union(Range("Sign1"), Range("Sign2"))
    On Error GoTo 0
    If Not rngS Is Nothing Then
        sh.Unprotect C_PWD
        rngS.Locked = False
        If Not Intersect(Target, rngS) Is Nothing Then
            If Application.CountA(rngS) = rngS.Cells.Count Then sh.Protect C_PWD
        End If
        Set rngS = Nothing
    End If
End Sub

**Mujahid_Sgd** · 02-02-2011, 05:18 AM

Can the same functionality by put in an add in so that I donot have to write the code behind everywork book.
I actually tried saving the book as an add in and then enabled that add in but it does not work even if I change the function type to public and define Sign1 and Sign2 in the other workbook

What am I doing wrong?