I use an excel workbook with multiple worksheets to track action items across
several teams. I was graciously provided an event macro from someone in this
discussion group to track changes to due dates. A copy of the current macro
follows.

This macro looks for a change in Column J (which is the due date) and if
detected, it records the user name, date/time, and the entry into a tracking
worksheet (named DUEDATE-CONT COMPLIANCE). It also brings over the data in
another column (Column A €“ which is the action number).

This is working well and I am finding it would be useful to record
additional data in the tracking worksheet (such as REASON FOR DUE DATE CHANGE
€“ Column H), when a due date change is made.

So I have two questions.

1. Can someone kindly advise me how to record additional columns of data
into the tracking worksheet?

2. Is it possible to record the name of the €˜tracked worksheet with this
info, so I can have only one tracking worksheet for the entire workbook?
Currently, I track each worksheet by individual tracking sheets.

The macro is as follows.

Private Sub Worksheet_Change(ByVal Target As Range)
'Column to be watched
Const sWatch As String = "J"
'Column of reference data that will show on Track sheet
Const sRef As String = "A"

Dim rWatch As Range
Dim rCell As Range
Dim sUser As String
Dim lOffset As Long

Set rWatch = Intersect(Target, Columns(sWatch))
If rWatch Is Nothing Then Exit Sub
sUser = Environ("username")
lOffset = Columns(sRef).Column - Columns(sWatch).Column
With Worksheets("DUEDATE-CONT COMPLIANCE")
ActiveSheet.Unprotect
For Each rCell In rWatch
With .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Value = rCell.Offset(0, lOffset)
.Offset(0, 1).Value = Now
.Offset(0, 2).Value = sUser
.Offset(0, 3).Value = rCell.Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowDeletingColumns:=True,
AllowDeletingRows:= _
True, AllowSorting:=True, AllowFiltering:=True
End With
Next rCell
End With

End Sub