VBA code to conditionally lock specific cells

[beth6441]

I am trying to do VBA code to conditionally lock specific cells based on the content of another cell.

Not having much luck...any help appreciated!

This is what I tried - but I can't get it to work:

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim cel As Range
    Dim r As Variant
    If Not Intersect(Range("D9:M9"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Me.Unprotect Password:="mypassword"
        For Each cel In Intersect(Range("D9:M9"), Target)
            ' Unlock all cells
            For Each r In Array(16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 42, 45, 47, 49, 51, 53, 55, 57, 59, 61, 63, 65, 67, 70, 72, 74, 76)
                With Cells(r, cel.Column)
                    .Locked = False
                    .ClearContents
                End With
            Next r
            Select Case cel.Value
                Case "YES"
                    For Each r In Array(18, 26, 30, 34, 38, 47, 49, 53, 74, 76, 78)
                        Cells(r, cel.Column).Locked = True
                    Next r
                Case "NO"
                    For Each r In Array(61)
                        Cells(r, cel.Column).Locked = True
                    Next r
               
            End Select
        Next cel
        Me.Protect Password:="mypassword"
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

 

[FracinDean]

The last bit of your code seems to lock the cells for both Case "Yes" and Case "No". Shouldn't one of them be

Cells(r, cel.Column).Locked = False

 

[Fluff]

In what way doesn't it work?

 

[beth6441]

Thank you for the suggestion. I figured out an alternative method by creating a formula, creating a unique name for the formula in Name Manager and then using Data Validation. The cell containing data validation will then display a list if D9=YES, otherwise it displays "".

 

[Fluff]

Glad you sorted it & thanks for the feedback.