Jul 29 2021 09:39 PM
Hi everyone, could someone help me out on this one please. So I have locked specific cells (highlighted on the pic). However, there were an existing script beside it (with red formatted column) which eventually doesn't work when I locked the cells. What did I missed? SampleFile and script were attached. Thanks in advance.
Sub LockCells()
Range("C14:C20").Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub
Jul 29 2021 11:54 PM
To make the BeforeDoubleClick code work, you should unprotect the sheet before it manipulates the cells and protect it again before the End Sub. Look at the line# 7 & 63.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr1
Dim arr2
Dim i As Long
Dim r As Long
Dim xCells As String
ActiveSheet.Unprotect
arr1 = Array(13, 21, 24, 27, 33, 39, 45, 51, 54, 60, 68, 76, 83, 88, 97, 101, 114, 119, 123, 131, 133, 147, _
160, 167, 172, 179, 183, 187, 190, 199, 202, 213, 216, 232, 236, 245, 248, 252, 256, 260, 262, 265, 271, 273)
arr2 = Array(6, 1, 1, 4, 4, 4, 4, 1, 1, 6, 6, 5, 3, 7, 2, 11, 3, 2, 6, 0, _
12, 11, 5, 3, 5, 2, 2, 1, 7, 1, 6, 1, 14, 2, 7, 1, 2, 2, 2, 0, 1, 4, 0, 4)
For i = 0 To UBound(arr1)
r = arr1(i) + 1
If Not Intersect(Range("B" & arr1(i)), Target) Is Nothing Then
Cancel = True
xCells = r & ":" & r + arr2(i)
If Target.Value = "+" Then
Rows(xCells).Hidden = False
Target.Value = "-"
Else
Rows(xCells).Hidden = True
Target.Value = "+"
End If
End If
xCells = "H" & r & ":H" & r + arr2(i)
If Not Intersect(Range(xCells), Target) Is Nothing Then
Cancel = True
Select Case Target.Value
Case "X"
Target.Value = "P"
Case "O"
Target.Value = "X"
Case Else
Target.Value = "O"
End Select
End If
Next i
'Review Process Tab - Status selection (Yes/No/NA)
If Not Intersect(Range("H282:H287"), Target) Is Nothing Then
Cancel = True
Select Case Target.Value
Case "X"
Target.Value = "P"
Case "O"
Target.Value = "X"
Case Else
Target.Value = "O"
End Select
End If
'OFS Process Tab - Status selection (Yes/No/NA)
If Not Intersect(Range("H290:H294"), Target) Is Nothing Then
Cancel = True
Select Case Target.Value
Case "X"
Target.Value = "P"
Case "O"
Target.Value = "X"
Case Else
Target.Value = "O"
End Select
End If
ActiveSheet.Protect
End Sub
Aug 01 2021 03:59 AM
Aug 01 2021 06:41 AM
Aug 01 2021 04:34 PM
@Subodh_Tiwari_sktneer
Appreciated the time that you are taking on this. How can I lock an un-contiguous range? ie. C14:C20, C22:C23, C25:C26, and any other ranges per se? Thanks much!
Aug 01 2021 08:12 PM
You may try something like this...
Dim rng As Range
Set rng = Range("C14:C20, C22:C23, C25:C26")
ActiveSheet.Unprotect 'Unprotect the sheet before you change the lock property along with the password if any
rng.Locked = True
ActiveSheet.Protect 'Protect the sheet again in the end
Aug 01 2021 09:47 PM
Not sure what I have missed but there's an error to it. Error says "unable to set the Locked property of the Range class". Thanks!
Aug 01 2021 11:32 PM