Lock cells with VBA script

%3CLINGO-SUB%20id%3D%22lingo-sub-2595834%22%20slang%3D%22en-US%22%3ELock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2595834%22%20slang%3D%22en-US%22%3E%3CP%3EHi%20everyone%2C%20could%20someone%20help%20me%20out%20on%20this%20one%20please.%20So%20I%20have%20locked%20specific%20cells%20(highlighted%20on%20the%20pic).%20However%2C%20there%20were%20an%20existing%20script%20beside%20it%20(with%20red%20formatted%20column)%20which%20eventually%20doesn't%20work%20when%20I%20locked%20the%20cells.%20What%20did%20I%20missed%3F%20SampleFile%20and%20script%20were%20attached.%20Thanks%20in%20advance.%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22lia-inline-image-display-wrapper%20lia-image-align-inline%22%20image-alt%3D%22rbalza_0-1627619812505.png%22%20style%3D%22width%3A%20400px%3B%22%3E%3CIMG%20src%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fimage%2Fserverpage%2Fimage-id%2F299475iFEE28EAF890CB166%2Fimage-size%2Fmedium%3Fv%3Dv2%26amp%3Bpx%3D400%22%20role%3D%22button%22%20title%3D%22rbalza_0-1627619812505.png%22%20alt%3D%22rbalza_0-1627619812505.png%22%20%2F%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ESub%20LockCells()%0A%20%20%20%20Range(%22C14%3AC20%22).Select%0A%20%20%20%20Selection.Locked%20%3D%20True%0A%20%20%20%20Selection.FormulaHidden%20%3D%20True%0A%20%20%20%20ActiveSheet.Protect%20DrawingObjects%3A%3DFalse%2C%20Contents%3A%3DTrue%2C%20Scenarios%3A%3DFalse%2C%20AllowFormattingCells%3A%3DTrue%2C%20AllowFormattingColumns%3A%3DTrue%2C%20AllowFormattingRows%3A%3DTrue%2C%20AllowInsertingColumns%3A%3DTrue%2C%20AllowInsertingRows%3A%3DTrue%2C%20AllowInsertingHyperlinks%3A%3DTrue%2C%20AllowDeletingColumns%3A%3DTrue%2C%20AllowDeletingRows%3A%3DTrue%2C%20AllowSorting%3A%3DTrue%2C%20AllowFiltering%3A%3DTrue%2C%20AllowUsingPivotTables%3A%3DTrue%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2595834%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597551%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597551%22%20slang%3D%22en-US%22%3EInsert%20a%20Breakpoint%20at%20the%20first%20line%20and%20then%20double%20click%20the%20cell%20the%20code%20will%20stop%20at%20the%20first%20line%20and%20then%20press%20F8%20key%20to%20execute%20one%20line%20at%20a%20time%20and%20when%20you%20get%20that%20error%2C%20go%20to%20the%20Review%20Tab%20and%20check%20if%20the%20worksheet%20is%20unprotected.%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597514%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597514%22%20slang%3D%22en-US%22%3E%3CP%3EHi%26nbsp%3B%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ENot%20sure%20what%20I%20have%20missed%20but%20there's%20an%20error%20to%20it.%20Error%20says%20%22unable%20to%20set%20the%20Locked%20property%20of%20the%20Range%20class%22.%20Thanks!%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22lia-inline-image-display-wrapper%20lia-image-align-inline%22%20image-alt%3D%22rbalza_0-1627879621939.png%22%20style%3D%22width%3A%20400px%3B%22%3E%3CIMG%20src%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fimage%2Fserverpage%2Fimage-id%2F299801i02A8D919E2AB6691%2Fimage-size%2Fmedium%3Fv%3Dv2%26amp%3Bpx%3D400%22%20role%3D%22button%22%20title%3D%22rbalza_0-1627879621939.png%22%20alt%3D%22rbalza_0-1627879621939.png%22%20%2F%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597488%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597488%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1098170%22%20target%3D%22_blank%22%3E%40rbalza%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20may%20try%20something%20like%20this...%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-visual-basic%22%3E%3CCODE%3EDim%20rng%20As%20Range%0ASet%20rng%20%3D%20Range(%22C14%3AC20%2C%20C22%3AC23%2C%20C25%3AC26%22)%0AActiveSheet.Unprotect%20'Unprotect%20the%20sheet%20before%20you%20change%20the%20lock%20property%20along%20with%20the%20password%20if%20any%0Arng.Locked%20%3D%20True%0AActiveSheet.Protect%20%20%20'Protect%20the%20sheet%20again%20in%20the%20end%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597433%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597433%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%26nbsp%3B%3CBR%20%2F%3E%3CBR%20%2F%3EAppreciated%20the%20time%20that%20you%20are%20taking%20on%20this.%20How%20can%20I%20lock%20an%20un-contiguous%20range%3F%20ie.%20C14%3AC20%2C%20C22%3AC23%2C%20C25%3AC26%2C%20and%20any%20other%20ranges%20per%20se%3F%20Thanks%20much!%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597221%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597221%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1098170%22%20target%3D%22_blank%22%3E%40rbalza%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20find%20the%20attached%20with%20the%20tweaked%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2597171%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2597171%22%20slang%3D%22en-US%22%3EHi%2C%20doesn't%20seem%20to%20work.%20Would%20you%20mind%20sharing%20how%20it%20works%2C%20please%3F%20Thanks!%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2595906%22%20slang%3D%22en-US%22%3ERe%3A%20Lock%20cells%20with%20VBA%20script%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2595906%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1098170%22%20target%3D%22_blank%22%3E%40rbalza%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3ETo%20make%20the%20BeforeDoubleClick%20code%20work%2C%20you%20should%20unprotect%20the%20sheet%20before%20it%20manipulates%20the%20cells%20and%20protect%20it%20again%20before%20the%20End%20Sub.%20Look%20at%20the%20line%23%207%20%26amp%3B%2063.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3EPrivate%20Sub%20Worksheet_BeforeDoubleClick(ByVal%20Target%20As%20Range%2C%20Cancel%20As%20Boolean)%0A%20%20%20%20Dim%20arr1%0A%20%20%20%20Dim%20arr2%0A%20%20%20%20Dim%20i%20As%20Long%0A%20%20%20%20Dim%20r%20As%20Long%0A%20%20%20%20Dim%20xCells%20As%20String%0A%20%20%20%20ActiveSheet.Unprotect%0A%20%20%20%20arr1%20%3D%20Array(13%2C%2021%2C%2024%2C%2027%2C%2033%2C%2039%2C%2045%2C%2051%2C%2054%2C%2060%2C%2068%2C%2076%2C%2083%2C%2088%2C%2097%2C%20101%2C%20114%2C%20119%2C%20123%2C%20131%2C%20133%2C%20147%2C%20_%0A%20%20%20%20%20%20%20%20160%2C%20167%2C%20172%2C%20179%2C%20183%2C%20187%2C%20190%2C%20199%2C%20202%2C%20213%2C%20216%2C%20232%2C%20236%2C%20245%2C%20248%2C%20252%2C%20256%2C%20260%2C%20262%2C%20265%2C%20271%2C%20273)%0A%20%20%20%20arr2%20%3D%20Array(6%2C%201%2C%201%2C%204%2C%204%2C%204%2C%204%2C%201%2C%201%2C%206%2C%206%2C%205%2C%203%2C%207%2C%202%2C%2011%2C%203%2C%202%2C%206%2C%200%2C%20_%0A%20%20%20%20%20%20%20%2012%2C%2011%2C%205%2C%203%2C%205%2C%202%2C%202%2C%201%2C%207%2C%201%2C%206%2C%201%2C%2014%2C%202%2C%207%2C%201%2C%202%2C%202%2C%202%2C%200%2C%201%2C%204%2C%200%2C%204)%0A%20%20%20%20For%20i%20%3D%200%20To%20UBound(arr1)%0A%20%20%20%20%20%20%20%20r%20%3D%20arr1(i)%20%2B%201%0A%20%20%20%20%20%20%20%20If%20Not%20Intersect(Range(%22B%22%20%26amp%3B%20arr1(i))%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20Cancel%20%3D%20True%0A%20%20%20%20%20%20%20%20%20%20%20%20xCells%20%3D%20r%20%26amp%3B%20%22%3A%22%20%26amp%3B%20r%20%2B%20arr2(i)%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20Target.Value%20%3D%20%22%2B%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Rows(xCells).Hidden%20%3D%20False%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22-%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Else%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Rows(xCells).Hidden%20%3D%20True%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22%2B%22%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20xCells%20%3D%20%22H%22%20%26amp%3B%20r%20%26amp%3B%20%22%3AH%22%20%26amp%3B%20r%20%2B%20arr2(i)%0A%20%20%20%20%20%20%20%20If%20Not%20Intersect(Range(xCells)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20Cancel%20%3D%20True%0A%20%20%20%20%20%20%20%20%20%20%20%20Select%20Case%20Target.Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22P%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22O%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Case%20Else%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22O%22%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20Select%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20Next%20i%0A%20%20%20%20%0A%20%20%20%20'Review%20Process%20Tab%20-%20Status%20selection%20(Yes%2FNo%2FNA)%0A%20%20%20%20If%20Not%20Intersect(Range(%22H282%3AH287%22)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20Cancel%20%3D%20True%0A%20%20%20%20%20%20%20%20Select%20Case%20Target.Value%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22P%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22O%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20Else%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22O%22%0A%20%20%20%20%20%20%20%20End%20Select%0A%20%20%20%20End%20If%0A%20%20%20%20'OFS%20Process%20Tab%20-%20Status%20selection%20(Yes%2FNo%2FNA)%0A%20%20%20%20If%20Not%20Intersect(Range(%22H290%3AH294%22)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20Cancel%20%3D%20True%0A%20%20%20%20%20%20%20%20Select%20Case%20Target.Value%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22P%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22O%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22X%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20Else%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Target.Value%20%3D%20%22O%22%0A%20%20%20%20%20%20%20%20End%20Select%0A%20%20%20%20End%20If%0A%20%20%20%20ActiveSheet.Protect%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E
Contributor

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. 

rbalza_0-1627619812505.png

 

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

 

 

7 Replies

@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

 

 

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

@rbalza 

Please find the attached with the tweaked code.

 

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

@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

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!

rbalza_0-1627879621939.png

 

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.