Tracking changes in Excel using an Event Macro

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

Here is a new version that tracks sheet name and contents of column H:
http://cjoint.com/?gfp4AxUBLf

HTH
--
AP

Ardus - I want to thank you once again for your help. This did the trick!

"Ardus Petus" wrote:

> Here is a new version that tracks sheet name and contents of column H:
> http://cjoint.com/?gfp4AxUBLf
>
> HTH
> --
> AP
>
>
>