Forum Discussion
rbalza
Jul 30, 2021Brass Contributor
Lock cells with VBA script
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...
Subodh_Tiwari_sktneer
Jul 30, 2021Silver Contributor
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
- rbalzaAug 01, 2021Brass ContributorHi, doesn't seem to work. Would you mind sharing how it works, please? Thanks!
- Subodh_Tiwari_sktneerAug 01, 2021Silver Contributor
- rbalzaAug 01, 2021Brass Contributor
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!