Protect non-empty cells VBA

I've added VBA code which will insert either the time or date to a cell upon double clicking. I managed to get that going pretty well.

The bit I'm struggling with is getting the cell to protect and lock after the time/date has been entered.

I've got to a point where when I double click/try to edit a non-empty cell, I get a runtime error. Upon debugging, the line that throws me up is "Target.Formula = Format(Now, "ttttt")".

I'm also not able to throw an error message either.

I'm so close!

Any advice would be truly appreciated!

My code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("C:E")) Is Nothing Then Cancel = True Target.Formula = Format(Now, "ttttt") End If If Not Intersect(Target, Range("A:A")) Is Nothing Then Cancel = True Target.Formula = Format(Now, "dd/mm/yyyy") End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ErrorHandler Dim xRg As Range Set xRg = Intersect(Range("A:A,C:E"), Target) If xRg Is Nothing Then Exit Sub Target.Worksheet.Unprotect Password:="123" xRg.Locked = True Target.Worksheet.Protect Password:="123" Exit Sub ErrorHandler: MsgBox "Cell already filled" Resume Next End Sub

Answer1:

The reason for your error is that the sheet is locked until some change happens on the worksheet, so if you remove the Worksheet_Change event and have your code as follows then it should work:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Target.Worksheet.Unprotect Password:="123" If Not Intersect(Target, Range("C:E")) Is Nothing Then If Target.Value = "" Then Cancel = True Target.Formula = Format(Now(), "ttttt") End If End If If Not Intersect(Target, Range("A:A")) Is Nothing Then If Target.Value = "" Then Cancel = True Target.Formula = Format(Now, "dd/mm/yyyy") End If End If Target.Worksheet.Protect Password:="123" End Sub

Answer2:

Protect your worksheet once with the UserInterfaceOnly:=True parameter and you won't have to unprotect/protect to alter cell contents with VBA.

sub protectOnce() worksheets("sheet1").unprotect password:="123" worksheets("sheet1").protect password:="123", UserInterfaceOnly:=True end sub

人吐槽 人点赞

Recommend

Comment

用户名: 密码:
验证码: 匿名发表

你可以使用这些语言

查看评论:Protect non-empty cells VBA