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