Don't allow empty cell with Intersect method

Question

I use data validation where user can select only two values in a list.

I'm also using Intersect method to add timestamp in the next cell when the change in a cell occurs.

The user, however, can still delete a value and leave the cell blank, and this is something I need to prevent.

Is it possible to implement this in the code below?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Pass As String
Pass = "somepassword"

ActiveSheet.Unprotect Password:=Pass

 If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then

   On Error GoTo ErrHandler

   ActiveSheet.Unprotect Password:=Pass
   Target.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
   ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, 
   Scenarios:=True, AllowFiltering:=True


End If

ErrHandler:
Exit Sub

End Sub

Answer 1

try this code:

Option Explicit

Dim OldTargetAddress As String
Dim OldTargetValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = OldTargetAddress And Target.Value = Empty Then
    Application.EnableEvents = False
    Target.Value = OldTargetValue
    Application.EnableEvents = True
    Exit Sub
End If


Dim Pass As String
Pass = "somepassword"

ActiveSheet.Unprotect Password:=Pass

 If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then

   On Error GoTo ErrHandler

   ActiveSheet.Unprotect Password:=Pass
   Target.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
   ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True


End If

ErrHandler:
Exit Sub

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldTargetAddress = Target.Address
    OldTargetValue = Target.Value
End Sub