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