Tracking row changes on the same row with fixed column

[Guest]

I need to track the date and username for data changed. However, I want to
only associate the date and username with the change for each row. The fixed
column for the date and username are "P" and "Q" (Columns 16 and 17). I am
using the following VBA script (from Mr Bernie Deitrick) to start off with
for the date and time of change, but am unsure of how to modify it so that
the data stays in the correct column and row. Also, need help on getting the
username input into column "Q".

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
If Not Intersect(Target, Range("E1:L1000")) Is Nothing Then
Application.EnableEvents = False
For Each myCell In Intersect(Target, Range("E1:L1000"))
myCell.Offset(0, 4).Value = "Cell " & _
myCell.Address(False, False) & " was changed " & _
Format(Now(), "mmm dd, yyyy at hh:mm:ss")
Next myCell
Application.EnableEvents = True
End If
End Sub

Thanks in advance

 

[Guest]

I made the change for the date and time. did not know what to use for the
user.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
If Not Intersect(Target, Range("E1:L1000")) Is Nothing Then
Application.EnableEvents = False
For Each myCell In Intersect(Target, Range("E1:L1000"))
Cells(myCell.Row, "P").Value = "Cell " & _
myCell.Address(False, False) & " was changed " & _
Format(Now(), "mmm dd, yyyy at hh:mm:ss")
Next myCell
Application.EnableEvents = True
End If
End Sub

 

[Gord Dibben]

Cells(myCell.Row, "Q").Value = Environ("username")
Next myCell


Gord Dibben MS Excel MVP

 

[Guest]

Thanks to all: Mr Deitrick responded with the following...props to him

Private Sub Worksheet_Change(ByVal Target As Range) Dim myCell As Range If
Not Intersect(Target, Range("E1:L1000")) Is Nothing Then
Application.EnableEvents = False
For Each myCell In Intersect(Target, Range("E1:L1000"))
Cells(myCell.Row, 16).Value = Now()
Cells(myCell.Row, 17).Value = Application.UserName
Next myCell
Application.EnableEvents = True
End If
End Sub

Though I would change it to this, to remove the limitation on the number of
rows - just in case you get to more than 1000 rows:

Private Sub Worksheet_Change(ByVal Target As Range) Dim myCell As Range If
Not Intersect(Target, Range("E:L")) Is Nothing Then
Application.EnableEvents = False
For Each myCell In Intersect(Target, Range("E:L"))
Cells(myCell.Row, 16).Value = Now()
Cells(myCell.Row, 17).Value = Application.UserName
Next myCell
Application.EnableEvents = True
End If
End Sub

Also, you may want to indicate which cell in the row changed and when.
To do this, you could keep a history of changes, starting in column P and
extending to the right:

Private Sub Worksheet_Change(ByVal Target As Range) Dim myCell As Range Dim
myCol As Integer If Not Intersect(Target, Range("E:L")) Is Nothing Then
Application.EnableEvents = False
For Each myCell In Intersect(Target, Range("E:L"))
If Cells(myCell.Row, Columns.Count).Value <> "" Then
MsgBox "The history record area for row " & myCell.Row & " is
completely filled."
Else
myCol = Application.Max(16, Cells(myCell.Row,
Columns.Count).End(xlToLeft)(1, 2).Column)
Cells(myCell.Row, myCol).Value = Application.UserName & "
changed " & _
myCell.Address(False, False) & " on " & Date & " at " &
Time()
End If
Next myCell
Application.EnableEvents = True
End If

Note that in cases where the row becomes completely filled with change
history data, you would need to decide what to do with the old data.

If you need any other help, just let me know.

Bernie

 

[Guest]

Phil: why don't your use P and Q rather than 16 and 17?
Cells(myCell.Row, 16).
Cells(myCell.Row, "P").

Cells(myCell.Row, 17)
Cells(myCell.Row, "Q")
)