CODEWITHSUNDEEP
excelvba
NoFace
NoFace

Reputation: 23

Conditional lock for certain range

Sub Macro3()
'
'
    Const MySecretPassword = "Hello"

    If ActiveSheet.Range("J49") Is Nothing Then Exit Sub

    On Error GoTo Protect
    If ActiveSheet.Range(J49).Value = "Password" Then
        ActiveSheet.Range("A1:R37").Locked = True
    Else
        ActiveSheet.Range("A1:R37").Locked = False
    End If
Protect:
    ActiveSheet.Protect MySecretPassword

End Sub

I also tried:

Sub Macro4()
'
' Private Sub Worksheet_Change(ByVal Target As Range)
 
    If ActiveSheet.Target = Range("J49") Then
        If ActiveSheet.Target.Value = "Password" Then
            ActiveSheet.Unprotect Password = "Hello"
        Else
            ActiveSheet.Protect Password = "Hello", DrawingObjects:=True, Contents:=True, Scenarios:=True
        End If
        
 End If
        


End Sub

and

Sub Macro5()
'
' Private Sub Worksheet_Change(ByVal Target As Range)

    If Target = Range("J49") Is Nothing Then
        ActiveSheet.Unprotect
        If Target.Value = "Pascal" Then
            Target.Offset(0, 1).Locked = False
        Else
            Target.Offset(0, 1).Locked = True
        End If
        ActiveSheet.Protect
    End If


'

'
End Sub

I'm trying to make an Excelfile with different sheets, in which I want to lock a certain range of cells when Cell J49 is filled with Password. I have browsed the forum to see solutions, but I'm struggling to get it to work. 1 person can be in charge for this file, that's why I really want the password protection. Can anyone point my mistake out?

Upvotes: 0

Views: 47

Answers (1)

Tim
Tim

Reputation: 78

Try something like that

Sub pass_test()
sheet_password = "secret"
range_password = "Pascal"
target_value = ActiveSheet.Range("J49").Value
target_address = "A1:B2"

If target_value <> "" Then
    ActiveSheet.Unprotect Password:=sheet_password
    If target_value = range_password Then
        ActiveSheet.Range(target_address).Locked = False
    Else
        ActiveSheet.Range(target_address).Locked = True
    End If
    ActiveSheet.Protect Password:=sheet_password
End If

End Sub

Upvotes: 1

Related Questions