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

do you mean that if target is empty then do not add a time stamp? — Siddharth Rout, Aug 14 '19 at 11:44
Also since you are working with `Worksheet_Change`, I would recommend reading [THIS](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) — Siddharth Rout, Aug 14 '19 at 11:47
@SiddharthRout no, then display a message that cell cannot be empty and check again if it's empty until it is not. — timetravelprimer, Aug 14 '19 at 11:52
Ok let me understand it... If it is empty then it prompts the user. Then when will it alert the user next? It can't be in a loop as It has to give the user time to enter data... Alternatively what you can do is use `Application.Undo` to restore the text i n the cell. — Siddharth Rout, Aug 14 '19 at 11:55
works good. but it still puts timestamp in the next cell. it's due to the change event i assume — timetravelprimer, Aug 14 '19 at 12:21
it will not if you check `If Len(Trim(Target.Value))<> 0 Then` and then put the time stamp. Also check the link that I mentioned above... It is for your good (Trust me) — Siddharth Rout, Aug 14 '19 at 12:23

score 1 · Accepted Answer · answered Aug 14 '19 at 11:58

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

Thank you! It does extactly what I want – timetravelprimer Aug 14 '19 at 12:28 — timetravelprimer, Aug 14 '19 at 12:28

Xabier · Answer 2 · 2019-08-14T12:03:57.403

How about the following, it will check whether the target value is nothing and prompt a message, also you might have to review how you protect and unprotect the sheet, as I'm unsure how the user is entering data if it's protected.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pass As String
Pass = "somepassword"

If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then
 ActiveSheet.Unprotect Password:=Pass
    On Error GoTo ErrHandler
    For Each acell In Target.Cells
        With acell
            If acell.Column = Me.ListObjects("Table1").ListColumns(6).Range.Column Then acell.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
        End With
    Next

    Set foundblank = Me.ListObjects("Table1").ListColumns(6).DataBodyRange.Find(What:="", LookIn:=xlValues, LookAt:=xlWhole)
    If Not foundblank Is Nothing Then
        MsgBox "Blank cell found", vbInformation, "Blank Found!"
        ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        Exit Sub
    End If
    ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End If

ErrHandler:
Exit Sub
End Sub

Don't allow empty cell with Intersect method

2 Answers2