My question is how do you get the initials of the user and date time stamp based on if someone changes a cell reference range (A1-J1) and then want the initials to be placed in K1 date to be stamped in column L1.
My question is how do you get the initials of the user and date time stamp based on if someone changes a cell reference range (A1-J1) and then want the initials to be placed in K1 date to be stamped in column L1.
Please install the code given below in the code sheet of the worksheet on which you wish to see the action. Read the comments in the code and note that you can move the action to different columns by assigning other values to the enumeration Nws at the top of the code. Action will be taken if a change occurs between columns NwsFirstData and NwsLastData. NwsInitials has no value assigned to it. Therefore Excel will assign the value NwsInitials + 1. You can assign another value to move the column elsewhere on the same sheet.
Option Explicit
Private Enum Nws ' worksheet navigation
' 13 Nov 2018
NwsFirstDataRow = 2 ' change as required
NwsFirstData = 1 ' 1 = column A
NwsLastData = 10 ' 10 = column J
NwsInitials
NwsTime
End Enum
Private Sub Worksheet_Change(ByVal Target As Range)
' 13 Nov 2018
Dim Rng As Range
Dim Rl As Long ' last used row
On Error Resume Next
' skip if more than 1 cell was changed
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo 0
Application.EnableEvents = False
' determine last used row in column NwsFirstData
Rl = Cells(Rows.Count, NwsFirstData).End(xlUp).Row
Set Rng = Range(Cells(NwsFirstDataRow, NwsFirstData), _
Cells(Rl + 1, NwsLastData))
If Application.Intersect(Target, Rng) Is Nothing Then
' don't allow modification of time stamp
Set Rng = Range(Cells(NwsFirstDataRow, NwsTime), _
Cells(Rl, NwsTime))
If Not Application.Intersect(Target, Rng) Is Nothing Then _
Application.Undo
Else
With Target
Cells(.Row, NwsInitials).Value = UserInitials
With Cells(.Row, NwsTime)
.Value = Now()
' modify the time stampe format to preference
.NumberFormat = "dd/mm/yy hh:mm:ss"
End With
End With
End If
Application.EnableEvents = True
End Sub
Private Function UserInitials() As String
' 13 Nov 2018
Dim Fun As String
Dim Sp() As String
Dim i As Long
Sp = Split(UCase(Application.UserName))
If Len(Join(Sp)) Then
Fun = Left(Sp(LBound(Sp)), 1)
If UBound(Sp) Then Fun = Fun & Left(Sp(UBound(Sp)), 1)
End If
UserInitials = Fun
End Function
The enumeration NwsFirstDataRow has a value of 2 which has the effect of taking no action if a change is made in row 1 which would usually hold captions. If you really want to record changes to row 1 change the value in the code: NwsFirstDataRow = 1.
The code prevents modification of the time stamp, undoing any change the user might make without notice, but permits changing the user initials. If you don't like that modify the code as follows.
Change this specification
Set Rng = Range(Cells(NwsFirstDataRow, NwsTime), _
Cells(Rl, NwsTime))
into this specification
Set Rng = Range(Cells(NwsFirstDataRow, NwsInitials), _
Cells(Rl, NwsTime))
If you make this change the columns NwsInitials and NwsTime must be adjacent to each other.
The system is implemented in the attached workbook. Observe that the workbook must be saved as macro-enabled (xlsm format) because it contains code.