Track changes by row in different worksheet - History tracking

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am looking for code that would copy a row that a change is being made on to
a separate worksheet. The data being copied would be the data before the
change. I have found code that create tracking base on each change made to
each cell...but I would like to have it base on the entire row of data. Each
row would include a date and time stamp alone with the userName. Column A is
a unique key on the Active worksheet and the history worksheet would hold the
hisotry of changed data. Any ideas would be great. Thanks.
 
Len,

Copy the code below, right click the sheet tab, select "View Code" and paste the code into the
window that appears.

Then put a blank sheet into your workbook, name it "History Sheet" (without the quotes), and any
change made to a single cell of your first worksheet will be tracked.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
Dim myVal As Variant
If Target.Cells.Count > 1 Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
myVal = Target.Value
.Undo
myRow = Sheets("History Sheet").Cells(Rows.Count, 3).End(xlUp)(2).Row
Intersect(Target.EntireRow, ActiveSheet.UsedRange).Copy _
Sheets("History Sheet").Cells(myRow, 3)
Sheets("History Sheet").Cells(myRow, 2).Value = Now
Sheets("History Sheet").Cells(myRow, 1).Value = .UserName
Target.Value = myVal
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
Thanks....that works great. But is there any way to only write 1 record to
the History Sheet for any changes to that row for that session. For example,
if I open the spread sheet and make changes to row 3 columns A, B, and C that
would generate the 1 entry on the History sheet. So is there any way to put
the Row number in a global variable so the application knows not to write
that record again?
 
Len,

Try the version below.

HTH,
Bernie
MS Excel MVP


Dim myRows() As Long

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
Dim myVal As Variant
If Target.Cells.Count > 1 Then Exit Sub

On Error GoTo NotDimmed
test = UBound(myRows)
GoTo Dimmed
NotDimmed:
ReDim myRows(1 To 1)
Dimmed:

For i = 1 To UBound(myRows)
If myRows(i) = Target.Row Then Exit Sub
Next i

ReDim Preserve myRows(1 To UBound(myRows) + 1)

myRows(UBound(myRows)) = Target.Row

With Application
.EnableEvents = False
.ScreenUpdating = False
myVal = Target.Value
.Undo
myRow = Sheets("History Sheet").Cells(Rows.Count, 3).End(xlUp)(2).Row
Intersect(Target.EntireRow, ActiveSheet.UsedRange).Copy _
Sheets("History Sheet").Cells(myRow, 3)
Sheets("History Sheet").Cells(myRow, 2).Value = Now
Sheets("History Sheet").Cells(myRow, 1).Value = .UserName
Target.Value = myVal
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
Thank you! That works great!

Bernie Deitrick said:
Len,

Try the version below.

HTH,
Bernie
MS Excel MVP


Dim myRows() As Long

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
Dim myVal As Variant
If Target.Cells.Count > 1 Then Exit Sub

On Error GoTo NotDimmed
test = UBound(myRows)
GoTo Dimmed
NotDimmed:
ReDim myRows(1 To 1)
Dimmed:

For i = 1 To UBound(myRows)
If myRows(i) = Target.Row Then Exit Sub
Next i

ReDim Preserve myRows(1 To UBound(myRows) + 1)

myRows(UBound(myRows)) = Target.Row

With Application
.EnableEvents = False
.ScreenUpdating = False
myVal = Target.Value
.Undo
myRow = Sheets("History Sheet").Cells(Rows.Count, 3).End(xlUp)(2).Row
Intersect(Target.EntireRow, ActiveSheet.UsedRange).Copy _
Sheets("History Sheet").Cells(myRow, 3)
Sheets("History Sheet").Cells(myRow, 2).Value = Now
Sheets("History Sheet").Cells(myRow, 1).Value = .UserName
Target.Value = myVal
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
Click to expand...
 
You're welcome. Thanks for letting me know that you got it to work....

Bernie
MS Excel MVP
 
Bernie,
I may have spoke too soon.... the code does not seem to like when I type in
a new row and then click to the next column. I am getting a Run-time error
'1004': Method 'undo' of object '_Application' failed. For example if I open
the Workbook and there are 5 rows of data, I type in row 6 column A and then
click to column B, the error occurs. I can see occording to what I asked
for there would not be a history created because there was nothing there when
the workbook was open, but maybe in this case defaulting to the data written
to column A or the entier row would help.....? Your thoughts?
 
Len,

I wrote it with the assumption that the changes were being made to existing filled-in rows of data.

Try this. Change

If Target.Cells.Count > 1 Then Exit Sub

to

If Target.Cells.Count > 1 Then Exit Sub
If Application.CountA(Target.EntireRow) = 1 Then Exit Sub


HTH,
Bernie
MS Excel MVP
 
Thanks again Bernie...that worked and yes I was acting as a typical
user...bad specs. But I have more.....
I want to be able to track deletes also. I know that there is no Delete
Event but with the following code I can back into a delete occurance:

Private Sub Worksheet_Activate()
glOldRows = Me.UsedRange.Rows.Count
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'determin if any Rows were deleted
If Me.UsedRange.Rows.Count < glOldRows Then
msg "Row deleted"
End If
glOldRows = Me.UsedRange.Rows.Count
Application.EnableEvents = True

Is there any suggestions as to how to handle this? I created a new column
on the History Sheet holding the new value of the change:
Sheets("History Sheet").Cells(myRow, 4)
Sheets("History Sheet").Cells(myRow, 3).Value = myVal 'new value
Sheets("History Sheet").Cells(myRow, 2).Value = Now
Sheets("History Sheet").Cells(myRow, 1).Value = .UserName

if this could be done I would like to default the "New value" cell to say
"Record Deleted"

Any ideas?
 
Thanks again Bernie...that worked and yes I was acting as a typical
user...bad specs. But I have more.....
I want to be able to track deletes also. I know that there is no Delete
Event but with the following code I can back into a delete occurance:

Private Sub Worksheet_Activate()
glOldRows = Me.UsedRange.Rows.Count
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'determin if any Rows were deleted
If Me.UsedRange.Rows.Count < glOldRows Then
msg "Row deleted"
End If
glOldRows = Me.UsedRange.Rows.Count
Application.EnableEvents = True

Is there any suggestions as to how to handle this? I created a new column
on the History Sheet holding the new value of the change:
Sheets("History Sheet").Cells(myRow, 4)
Sheets("History Sheet").Cells(myRow, 3).Value = myVal 'new value
Sheets("History Sheet").Cells(myRow, 2).Value = Now
Sheets("History Sheet").Cells(myRow, 1).Value = .UserName

if this could be done I would like to default the "New value" cell to say
"Record Deleted"

Any ideas?
 
I found this very helpfull, but how can I update multiple cells in one row,
then have that row written to the history worksheet? It seems that after i
update one cell in that row, it will not transfer the history to the other
worksheet.
 
Just want to report an "Anomaly" with the code posted at the start of this
thread:

If you are in your worksheet, and do a drag/copy type operation, (ie, drag
corner of cell in row 2 down one row, to row 3, it actually corrupts the
original formula. The result is that the formula in row 2 is not copied to
row 3 cell, but rather, the "actual value" of the result of the formula.

Drag/copy to down multiple row works fine from the source worksheet
perspective, but the rows changed are not copied to the history sheet.

Just thought folks should be aware. I am trying to figure out how to fix it.
 
Back
Top