2016 Excel VBA Code for Locking a Cell after Data Entry

[Lobo1943]

I have made a macro for my spreadsheet that is supposed to conditional lock cells aft date is entered. I've tried running the macro but I get a debug notice at this lie cl.Locked = "True"

This is the full macro: I am hoping someone can help me resolve the issue


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
ActiveSheet.Protect Password:="123"
For Each cl In Target
If cl.Value <> "" Then
check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")
If check = vbYes Then
cl.Locked = "True"
Else
cl.Value = ""
End If
End If
Next cl
Activeshet.Protect Password:="123"

[rollis13]

That's because you should begin with:
ActiveSheet.Unprotect Password:="123"and end your macro with:
ActiveSheet.Protect Password:="123"Instead you begin with .Protect and end with a typo.

[Paul_Hossler]

try this

Also did a little formatting on the MsgBox



Option Explicit


'I assume that the entire WS is Locked = False


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim check As VbMsgBoxResult


For Each cl In Target
With cl
If Len(.Value) > 0 Then

check = MsgBox("Is this entry correct?" & vbCrLf & vbCrLf & _
vbTab & .Value & " (" & .Address(False, False) & ")" & vbCrLf & vbCrLf & _
"This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")

If check = vbYes Then
If Me.ProtectContents Then Me.Unprotect Password:="123" ' unprotect first
.Locked = True
Me.Protect Password:="123" ' not Activeshet.

Else
.ClearContents
ActiveCell.Offset(-1, 0).Select ' reselect data entry cell
End If
End If
End With
Next cl



End Sub

[Lobo1943]

Thanks for you for your help, what would I add if I needed to change a cell after data was entered into a cell and I selected yes, and then realized the data was incorrect? How would I unprotect the cell to make a chance, preferably using a short password? The work is being shared with a group of employees.

[Paul_Hossler]

Implemented via RightClick

Could probably use some more error checking




Option Explicit


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim rCell As Range
Dim ans As VbMsgBoxResult


For Each rCell In Target.Cells
With rCell
If Len(.Value) > 0 Then

ans = MsgBox("Do you want to reset this cell?" & vbCrLf & vbCrLf & _
vbTab & .Value & " (" & .Address(False, False) & ")", vbYesNo, "Cell Lock Notification")

If ans = vbYes Then
If ActiveSheet.ProtectContents Then ActiveSheet.Unprotect Password:="123" ' unprotect first
Application.EnableEvents = False
.ClearContents
.Locked = False
Application.EnableEvents = True
ActiveSheet.Protect Password:="123"
End If
End If
End With
Next

Cancel = True

End Sub


'I assume that the entire WS is Locked = False
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim ans As VbMsgBoxResult


For Each rCell In Target
With rCell
If Len(.Value) > 0 Then

ans = MsgBox("Is this entry correct?" & vbCrLf & vbCrLf & _
vbTab & .Value & " (" & .Address(False, False) & ")" & vbCrLf & vbCrLf & _
"This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")

If ans = vbYes Then
If Me.ProtectContents Then Me.Unprotect Password:="123" ' unprotect first
.Locked = True
Me.Protect Password:="123" ' not Activeshet.

Else
.ClearContents
ActiveCell.Offset(-1, 0).Select ' reselect data entry cell
End If
End If
End With
Next rCell
End Sub