Problem with username and time stamp

[RandyD123]

So I'm using this code to put a username and time stamp when a user starts an entry in Column B. The code works perfectly, until the user decides that they don't really want to make an entry and they backspace it out. The username and timestamp remain. The other problem is that if a user deletes the row the code breaks. What I need to be able to do is if the user decides that they made a mistake on that line and either delete it or back space it out the username and time stamp go away as well. The shaded area will be locked so the user can't backspace that out.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B4:B2000")) Is Nothing Then Exit Sub

Application.EnableEvents = False

With Target
    .Offset(, 6).Value = Environ("username")
    .Offset(, 7).Value = Date
    
End With
Application.EnableEvents = True
End Sub

Any help would be most appreciated.

Book1 - Copy.xlsm
	B	C	D	E	F	G	H	I
1
2
3	STW (Person Working)	STO (Person Not Working)	Date Shift Trade Will Occur	Time Start	Time End	Total Hours Traded Off	Person Who Made This Entry	Date Person Made This Entry
4	Name #08	Name #03	01/17/23	0400	0800	4.0
5	Name #03	Name #01	02/27/23	1200	1630	4.5
6	Name #04	Name #03	03/15/23	1300	1830	5.5
7	Name #06	Name #01	04/22/23	0430	0730	3.0
8	Name #02	Name #04	04/28/23	0730	2000	12.5
9	Name #08	Name #04	05/02/23	1130	1730	6.0
10	Name #05	Name #02	05/14/23	0330	1200	8.5
11	Name #01	Name #03	06/12/23	1800	2000	2.0
12	Name #07	Name #01	07/04/23	1700	2400	7.0
13	Name #71	Name #02	07/30/23	0330	0730	4.0
14	Name #08	Name #02	08/02/23	0330	1200	8.5
15	Name #110	Name #72	08/17/23	1300	1800	5.0
16	Name #119	Name #118	08/18/23	1300	1800	5.0
17	Name #06	Name #04	08/19/23	0330	1200	8.5
18	Name #22	Name #01	09/22/23	0800	1200	4.0
19	Name #114	Name #105	09/27/23	1200	1800	6.0
20	Name #117					0.0	Randy	5/8/2023
21						0.0
22						0.0
23						0.0
Shift Trades

Cell Formulas
Range	Formula
G4:G23	G4	=(TEXT(F4,"00\:00")-TEXT(E4,"00\:00"))*24

Cells with Data Validation
Cell	Allow	Criteria
B4:C23	List	=Data!$B$4:$B$149

 

[DanteAmor]

Hi @RandyD123 . Thaks for posting on MrExcel board.

The other problem is that if a user deletes the row the code breaks.

I present you 2 options:

1) If they delete the whole row, the code is not executed and we allow to delete the whole row.
Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B4:B2000")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
 
  Application.EnableEvents = False
 
  With Target
    If .Value = "" Then
      .Offset(, 6).Value = ""
      .Offset(, 7).Value = ""
    Else
      .Offset(, 6).Value = Environ("username")
      .Offset(, 7).Value = Date
    End If
  End With
  Application.EnableEvents = True
End Sub

2) But if you don't want them to modify more than one cell at a time, then we send a message, undo what they did and allow only one cell to be modified:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B4:B2000")) Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
 
  If Target.Count > 1 Then
    MsgBox "It is not possible to modify more than one cell", vbCritical
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
  End If
 
  With Target
    If .Value = "" Then
      .Offset(, 6).Value = ""
      .Offset(, 7).Value = ""
    Else
      .Offset(, 6).Value = Environ("username")
      .Offset(, 7).Value = Date
    End If
  End With
  Application.EnableEvents = True
End Sub

Make your tests and apply the one you like the most. The 2 proposals include deletion of the user and date stamp in case the cell in column B is deleted.

Or if you want another alternative, come here comment how you would like it.


--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[RandyD123]

Wasn't really sure of what you meant on the second code. But a quick test on the first code seems to work perfectly. I can delete rows, insert rows and backspace out a row, with no errors!!! Thank You!!!