Today I created an Excel workbook that keeps track of changes in your data, on a hidden worksheet called history.
This is the VBA script I used, the code must be placed in ThisWorkbook,
Option Explicit
Public oldValue As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intRows As Integer
Dim rngCell As Range
intRows = Sheets("history").UsedRange.Rows.Count + 1
'MsgBox Target.Count
'to prevent changes on the history sheet are recorder as well
If Sh.Name <> "history" Then
intRows = Sheets("history").UsedRange.Rows.Count + 1
If Target.Count = 1 Then
Sheets("history").Cells(intRows, 1).Offset(0, 0).Value = Target.Address
Sheets("history").Cells(intRows, 1).Offset(0, 1).Value = oldValue
Sheets("history").Cells(intRows, 1).Offset(0, 2).Value = Target.Value
Sheets("history").Cells(intRows, 1).Offset(0, 3).Value = Now()
Sheets("history").Cells(intRows, 1).Offset(0, 4).Value = Sh.Name
Sheets("history").Cells(intRows, 1).Offset(0, 5).Value = Application.UserName
Else
For Each rngCell In Target.Cells
intRows = Sheets("history").UsedRange.Rows.Count + 1
Sheets("history").Cells(intRows, 1).Offset(0, 0).Value = rngCell.Address
Sheets("history").Cells(intRows, 1).Offset(0, 1).Value = oldValue
Sheets("history").Cells(intRows, 1).Offset(0, 2).Value = rngCell.Value
Sheets("history").Cells(intRows, 1).Offset(0, 3).Value = Now()
Sheets("history").Cells(intRows, 1).Offset(0, 4).Value = Sh.Name
Sheets("history").Cells(intRows, 1).Offset(0, 5).Value = Application.UserName
Next
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
End Sub
This is the VBA script I used, the code must be placed in ThisWorkbook,
Option Explicit
Public oldValue As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intRows As Integer
Dim rngCell As Range
intRows = Sheets("history").UsedRange.Rows.Count + 1
'MsgBox Target.Count
'to prevent changes on the history sheet are recorder as well
If Sh.Name <> "history" Then
intRows = Sheets("history").UsedRange.Rows.Count + 1
If Target.Count = 1 Then
Sheets("history").Cells(intRows, 1).Offset(0, 0).Value = Target.Address
Sheets("history").Cells(intRows, 1).Offset(0, 1).Value = oldValue
Sheets("history").Cells(intRows, 1).Offset(0, 2).Value = Target.Value
Sheets("history").Cells(intRows, 1).Offset(0, 3).Value = Now()
Sheets("history").Cells(intRows, 1).Offset(0, 4).Value = Sh.Name
Sheets("history").Cells(intRows, 1).Offset(0, 5).Value = Application.UserName
Else
For Each rngCell In Target.Cells
intRows = Sheets("history").UsedRange.Rows.Count + 1
Sheets("history").Cells(intRows, 1).Offset(0, 0).Value = rngCell.Address
Sheets("history").Cells(intRows, 1).Offset(0, 1).Value = oldValue
Sheets("history").Cells(intRows, 1).Offset(0, 2).Value = rngCell.Value
Sheets("history").Cells(intRows, 1).Offset(0, 3).Value = Now()
Sheets("history").Cells(intRows, 1).Offset(0, 4).Value = Sh.Name
Sheets("history").Cells(intRows, 1).Offset(0, 5).Value = Application.UserName
Next
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
End Sub
You need an additional sheet called history to store the changes. In the North American Excel version, history is a reserved name. So you have to think of a different one. You can hide this sheet, of course. The sheet will look like this:
+Brian Canes tipped me to shorten the Workbook_SheetChange code to:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intRows As Integer
Dim rngCell As Range
intRows = Sheets("history").UsedRange.Rows.Count + 1
'MsgBox Target.Count
'to prevent changes on the history sheet are recorder as well
If Sh.Name <> "history" Then
intRows = Sheets("history").UsedRange.Rows.Count + 1
If Target.Count = 1 Then
Sheets("History").Cells(intRows, 1).Resize(1, 6) = _
Array(Target.Address, oldValue, Target.Value, Now(), Sh.Name, Application.UserName)
Else
For Each rngCell In Target.Cells
intRows = Sheets("history").UsedRange.Rows.Count + 1
Sheets("History").Cells(intRows, 1).Resize(1, 6) = _
Array(Target.Address, oldValue, Target.Value, Now(), Sh.Name, Application.UserName)
Next
End If
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intRows As Integer
Dim rngCell As Range
intRows = Sheets("history").UsedRange.Rows.Count + 1
'MsgBox Target.Count
'to prevent changes on the history sheet are recorder as well
If Sh.Name <> "history" Then
intRows = Sheets("history").UsedRange.Rows.Count + 1
If Target.Count = 1 Then
Sheets("History").Cells(intRows, 1).Resize(1, 6) = _
Array(Target.Address, oldValue, Target.Value, Now(), Sh.Name, Application.UserName)
Else
For Each rngCell In Target.Cells
intRows = Sheets("history").UsedRange.Rows.Count + 1
Sheets("History").Cells(intRows, 1).Resize(1, 6) = _
Array(Target.Address, oldValue, Target.Value, Now(), Sh.Name, Application.UserName)
Next
End If
End If
End Sub
Reacties