VBA Lock and Unlock Cell Help

[PokeCoder]

I need a little guidance. I do not want to use Data Validation to restrict data entry in the cells as the warnings for accidentally typing will decrease productivity. I want the user to be able to select from the list in the Table column C and it lock the unnecessary cells so they can quickly tab over the locked cells. I will need the code to function for each line in my table. I used my target range as ActiveSheet.ListObjects so it will also continue to work with the sheet is copied for the next month. I have also tried C3:C (my data does begin on line 3) as the target range and still cannot get it to work.

My drop box in the Column C (Table Column Header is Payment Type) has 3 possibilities
PDPM- should lock AE:AJ in each row if selected
RUGs IV- should lock AA:AD in each row
Levels- should lock AA:AJ

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range(ActiveSheet.ListObjects(1).Name & "[[#All],[Payment Type]]")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="Protection"
    Select Case Target.Value
        Case "PDPM"
            Range("AE" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case "RUGs IV"
            Range("AA" & Target.Row & ":AD" & Target.Row).Locked = True
        Case "Levels"
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case Else
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False
    End Select
    ActiveSheet.Protect Password:="Protection"
End Sub

So frustrated!!!

 

[Leith Ross]

Hello PokeCoder,

All cells by default have their Locked property set to True. Cells are only locked when the worksheet is protected. So, you need to select the cells the users can change and change the Locked property to False. Once you protect the worksheet, the user can freely tab to cells you have unlocked and edit them.

 

[DanteAmor]

Add this line:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range(ActiveSheet.ListObjects(1).Name & "[[#All],[Payment Type]]")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="Protection"
[COLOR=#0000ff]    Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False[/COLOR]
    Select Case Target.Value
        Case "PDPM"
            Range("AE" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case "RUGs IV"
            Range("AA" & Target.Row & ":AD" & Target.Row).Locked = True
        Case "Levels"
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case Else
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False
    End Select
    ActiveSheet.Protect Password:="Protection"
End Sub

 

[PokeCoder]

My sheet is protected. All cells in the table are unlocked for editing and the rest of the sheet is locked and protected. But I would like the VBA to lock certain ones based on the input in Column C

 

[PokeCoder]

Unfortunately it still does not lock the cells

Add this line:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range(ActiveSheet.ListObjects(1).Name & "[[#All],[Payment Type]]")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="Protection"
[COLOR=#0000ff]    Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False[/COLOR]
    Select Case Target.Value
        Case "PDPM"
            Range("AE" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case "RUGs IV"
            Range("AA" & Target.Row & ":AD" & Target.Row).Locked = True
        Case "Levels"
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case Else
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False
    End Select
    ActiveSheet.Protect Password:="Protection"
End Sub

 

[DanteAmor]

Unfortunately it still does not lock the cells

How?


What it does is unprotect the sheet, unlock all cells, depending on the data (PDPM, RUGs IV, Levels) then the portion you need is locked.


Or I don't understand what you need.
You could describe an example step by step.

 

[PokeCoder]

I must have pasted the code wrong. I just deleted everything and re-pasted it in and it works!!! Thank you so very much. I have been working on this for days!

 

[PokeCoder]

I did end up adding an error handler. After I started running my other codes. I also updated my other codes with Application.EnableEvents = False and ended them with Application.EnableEvents = True to prevent this Macro from running every time I ran another Macro (I have some to add rows, copy the worksheet, sort, and search). Again, thank you so very much for your assistance! You are a life saver!!
Here is the final code I used:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Intersect(Target, Range(ActiveSheet.ListObjects(1).Name & "[[#All],[Payment Type]]")) Is Nothing Then Exit Sub
    On Error GoTo Cancelled
ActiveSheet.Unprotect Password:="Protection"
    Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False
    Select Case Target.Value
        Case "PDPM"
            Range("AE" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case "RUGs IV"
            Range("AA" & Target.Row & ":AD" & Target.Row).Locked = True
        Case "Levels"
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = True
        Case Else
            Range("AA" & Target.Row & ":AJ" & Target.Row).Locked = False
    End Select
    ActiveSheet.Protect Password:="Protection"
Cancelled:
    Exit Sub
End Sub

 

[DanteAmor]

I must have pasted the code wrong. I just deleted everything and re-pasted it in and it works!!! Thank you so very much. I have been working on this for days!

Dont worry. I'm glad to help you. Thanks for the feedback.