Need help in locking selected range of cells using VBA - vba

Question

I need help in locking specific range of cells based on the selection of value from list from another cell.
To be specific, I have created data validation list for columns N5 to N36, upon selection of value "Exist" from the cell N5, I want to lock that specific row O5 to U5.
i.e "Exist" in N6 would lock O6 to U6 and so on.
Similarly for the other rows till N36.
And if the user selects "Does not Exist", then I would want those cells to remain unlocked and editable similar to the above condition.
I have tried macros from various forums using my very basic knowledge of using macros, but most of those lock the entire sheet.
Code I tried:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N5:N36")) Is Nothing Then
ActiveSheet.Unprotect
If Target.Value = "Exist" Then
Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = False
Else
Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = True
End If
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
I would really appreciate your quick help.
Thanks in Advance.

Answer 1

Is this what you are trying (Tried And Tested)? Also see THIS. It's worth a read.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Long
Dim sPass As String
'~~> Password
sPass = "BlahBLah"
On Error GoTo Whoa
'~~> For excel 2003 use .Count instead of .CountLarge
'~~> In case of multiple cells were changed
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("N5:N36")) Is Nothing Then
If UCase(Trim(Target.Value)) = "EXIST" Then
rw = Target.Row
With ActiveSheet
.Unprotect sPass
.Cells.Locked = False
.Range("O" & rw & ":U" & rw).Locked = True
.Protect Password:= sPass , DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub

Answer 2

you could do something like this:
Sub LockCells()
'unprotect the sheet
ActiveSheet.Unprotect
'unlock all cells
Cells.Locked = False
Cells.FormulaHidden = False
Dim cell As Range
'find all cells that need to be locked
For Each cell In Range("N5:N36")
If cell = "Exist" Then
Range("O" & cell.Row & ":U" & cell.Row).Locked = True
Range("O" & cell.Row & ":U" & cell.Row).FormulaHidden = True
End If
Next cell
'protect the sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub