Lock cells with VBA script

[rbalza]

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

[#2]

@rbalza 

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

[#3]

Hi, doesn't seem to work. Would you mind sharing how it works, please? Thanks!

[#4]

@rbalza 

Please find the attached with the tweaked code.

[#5]

@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!

[#6]

@rbalza 

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

[#7]

Hi @Subodh_Tiwari_sktneer,

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!

[#8]

Insert a Breakpoint at the first line and then double click the cell the code will stop at the first line and then press F8 key to execute one line at a time and when you get that error, go to the Review Tab and check if the worksheet is unprotected.