Forum Discussion

rbalza's avatar
rbalza
Brass Contributor
Jul 30, 2021

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

 

 

excel
Formulas and Functions
Macros and VBA

7 Replies

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Jul 30, 2021

    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

     

     

Resources