Track changes by row in different worksheet - History tracking

[LenJr]

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.

 

[Bernie Deitrick]

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

 

[LenJr]

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?

 

[Bernie Deitrick]

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

 

[LenJr]

Thank you! That works great!

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

 

[Bernie Deitrick]

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

Bernie
MS Excel MVP

 

[LenJr]

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?

 

[Bernie Deitrick]

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

 

[LenJr]

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?

 

[LenJr]

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?

 

[Mike]

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.

 

[PatK]

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.