apsblackhorse
New Member
- Joined
- Jul 28, 2021
- Messages
- 5
- Office Version
- 365
- Platform
- Windows
Hi everyone, could someone help me out on this one, please. So I have locked specific cells (highlighted on the pic). However, there was an existing script beside it (with a red formatted column) which eventually doesn't work when I locked the cells. What did I miss? SampleFile and script were attached. Thanks in advance.
VBA Code:
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