Conditional Unlocking

[hektisk]

Hello: I would like to add VBA code to a worksheet which unlocks certain cells if certain criteria are met. Basically, if cell a3 says anything other than 'New Assessment (No DC)' or is left blank, then b3:h3 should be unlocked. The same applies for a4 and b4:h4, a5 and b5:h5, and so on and so forth.

I've found numerous examples of conditional locking/unlocking in google, but none that quite do what I'm looking to do, and I don't know VBA well enough (that is, at all really ) to modify it accordingly. Any help is greatly appreciated.

[jaslake]

Hi hektisk

I think this does as you requested

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A4:A14")) Is Nothing Then
        If Target.Value = "New Assessment (No DC)" Then
            ActiveSheet.Unprotect
            Target.Offset(0, 1).Resize(1, 7).Locked = False
            ActiveSheet.Protect
        Else
            ActiveSheet.Unprotect
            Target.Offset(0, 1).Resize(1, 7).Locked = True
            ActiveSheet.Protect
        End If
    End If
End Sub

Place the code in Sheet1 Module.

Let me know of issues.

[hektisk]

Thank you very much. To make sure I'm doing this right...the sheet is protected, and b3:h14 are locked. I right click on the sheet, and go to 'View Code'. I then go to Insert->Module and copy and paste the code in there. Is there anything else I need to do to 'run' the subroutine?

Hi hektisk

I think this does as you requested

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A4:A14")) Is Nothing Then
        If Target.Value = "New Assessment (No DC)" Then
            ActiveSheet.Unprotect
            Target.Offset(0, 1).Resize(1, 7).Locked = False
            ActiveSheet.Protect
        Else
            ActiveSheet.Unprotect
            Target.Offset(0, 1).Resize(1, 7).Locked = True
            ActiveSheet.Protect
        End If
    End If
End Sub

Place the code in Sheet1 Module.

Let me know of issues.

[jaslake]

Hi hektisk
Almost...right click on the sheet (Sheet1) based on your sample file...copy the code into the window on the right. The code DOES NOT go in a general module...it goes in the sheet module.
See attached.

[hektisk]

OK, prior to your post I had put the code both in the worksheet module and general module just in case, and but neither seemed to work. I opened the workbook you sent me, enabled macros, and every cell from b3:h13 are locked, no matter the data in a3:a13. I see the text you inputted in b7:b9, so I'm not sure what I'm doing wrong. Is there something else I need to do? Thank you again.

Hi hektisk
Almost...right click on the sheet (Sheet1) based on your sample file...copy the code into the window on the right. The code DOES NOT go in a general module...it goes in the sheet module.
See attached.

[jaslake]

Hi hektisk
I'd be glad to help you debug this but I'm color blind...not kidding...remove the colors from your file and repost...can't "see" what's going on.

[nimrod]

Hello hektisk:
Have you thought of using Data Validation instead ? This would require no macros .

Example
1) Select B3:H3
2) Open "Data Validation" tool window
3) Select Setting Tab
4) Select "Custom" from "Allow" drop down list
5) In Validations "Formula" text box type = $A$3 <>"'New Assessment (No DC)"
6. Select Validations "Error Alert" tab and type in the error message you want displayed.

... now user cannot type in b3:h3 when the text "'New Assessment (No DC)" is in cell A3

[jaslake]

Hi nimrod

Your approach is sound...however, with the sheet protected, I'm unfamiliar with how to unlock the requisite cells if 'New Assessment (No DC)" is selected via data validation without code. How do you do this?

[protonLeah]

My contribution:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Testcell    As Range, _
        DataRange   As Range
    
    Set Testcell = Target
    
    'check if more than one cell selected or not column A and quit
    If Testcell.Count > 1 Or Testcell.Column > 1 Then Exit Sub
    
    ActiveSheet.Unprotect
    Set DataRange = Range("B" & Testcell.Row & ":H" & Testcell.Row)
    
    If Testcell.Value <> "New Assessment (No DC)" Then
        DataRange.Locked = False
    Else
        DataRange.Locked = True
    End If
    
    Call LockSheet
End Sub
Private Sub LockSheet()
    With ActiveSheet
        .Protect _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True
        
        .EnableSelection = xlUnlockedCells
    End With
End Sub