track row changes with date and time stamp



I looked at a similiar request called "Track changes by row in different
worksheet - History tracking" that was posted previously and tried to modify

What I would like to do is take my 37 column spreadsheet with a header row
and anytime any cell in a row is changed write the original row to the
History Sheet with the user ID (network) and a date and time stamp. I would
like the header row to be in the History file. If the ultimate was available
the changed cell(s) would be highlighted with a different color.

Patrick Molloy

to do this you'll need to keep a copy of the sheet. This is because once a
cell value is changed, you won't know what it was
The copy will give you this.
so use the change event to do two things....write the change to the history
file and also update the copy

so I have three sheets ... Main, MainCopy and MainHistory
whenever a change is made to Main, then MainCopy is updated and so is

This is the code behind Main:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim saddress As String
saddress = Target.Address
If Worksheets("MainCopy").Range(saddress).Value <> Target.Value Then
With Worksheets("MainHistory").Range("A" & Rows.Count).End(xlUp).Offset(1)
.Value = Cells(1, Target.Column) ' header
.Offset(, 1) = Worksheets("MainCopy").Range(saddress).Value 'old value
.Offset(, 2) = Target.Value 'new value
.Offset(, 3) = Environ$("username") 'user
.Offset(, 4) = Now
End With
Worksheets("MainCopy").Range(saddress).Value = Target.Value
End If
End Sub


This does what I need but I think I need to have an event when the workbook
is open to copy the main to the maincopy. If you can tell me how to do that
it would be appreciated. I think I could figure that one out but I am a
novice and have had times when I thought I had it right and then found it
didn't work well under circumstances I didn't test.

Also I added a line to capture what is in column 1 ( the name of the server)
so I can figure what specific server the change applies to. I added this to
your work

..Offset(, 4) = Now
.Offset(, 5) = Cells(Target.Row, 1) ' server name

I would really like the server name to be in column 1 on MainHistory
worksheet but I tried to move it and messed things up. The server name is now
the last column

Thanks for your help and it is appreciated. Thank You

Patrick Molloy

sorry - missed your response.

In the dev environment, go to the code paeg for ThisWorkbook (look in
Project Explorer and right click the icon) then add this code

Option Explicit
Private Sub Workbook_Open()
Dim source As Range
Set source = Worksheets("Sheet1").UsedRange
With source
Worksheets("sheet2").Range(.Address).Value = .Value
End With
End Sub

Patrick Molloy

With Worksheets("MainHistory").Range("A" & Rows.Count).End(xlUp).Offset(1)
.Value = Cells(Target.Row, 1) ' server name
.Offset(,1) = Cells(1, Target.Column) ' header
.Offset(, 2) = Worksheets("MainCopy").Range(saddress).Value 'old
.Offset(, 3) = Target.Value 'new value
.Offset(, 4) = Environ$("username") 'user
.Offset(, 5) = Now
End With


Thank you,

I am getting a little better at this but sure do appreciate having a
knowledgable person provide valuable insight and code.

Have a great day

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question