0
Undo
Votes
I have a script that allows me lock cells based on a condition
If cell D3 = 'X' then protect cells c3:d35
But i would like to repeat the same condition for several other cells (namely 12 colums - calendar based)
What is the best way to do it as I am struggling?
Private Sub Worksheet_Activate()
If Not ActiveSheet.ProtectContents Then
Range("d3").Locked = False
Range("c4:c35").Locked = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range, xRgA As Range
On Error Resume Next
Application.EnableEvents = False
Set xRg = Range("c4:c35")
Set xRgA = Range("d3")
If Intersect(Target, xRg).Address <> Target.Address _
Or xRgA = "Under Review" Then
Application.EnableEvents = True
Exit Sub
ElseIf ActiveSheet.ProtectContents _
And Intersect(Target, xRg) = Target _
And xRgA.Value = "Approved" Then
xRgA.Select
End If
Application.EnableEvents = True
End Sub
If cell D3 = 'X' then protect cells c3:d35
But i would like to repeat the same condition for several other cells (namely 12 colums - calendar based)
What is the best way to do it as I am struggling?
Private Sub Worksheet_Activate()
If Not ActiveSheet.ProtectContents Then
Range("d3").Locked = False
Range("c4:c35").Locked = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range, xRgA As Range
On Error Resume Next
Application.EnableEvents = False
Set xRg = Range("c4:c35")
Set xRgA = Range("d3")
If Intersect(Target, xRg).Address <> Target.Address _
Or xRgA = "Under Review" Then
Application.EnableEvents = True
Exit Sub
ElseIf ActiveSheet.ProtectContents _
And Intersect(Target, xRg) = Target _
And xRgA.Value = "Approved" Then
xRgA.Select
End If
Application.EnableEvents = True
End Sub
There are no replies made for this post yet.