The code has been updated to reference the changes below.
This log system create an external document for Excel called Log.txt, it will create a line in the log.txt file that looks like this:
11:27:20 AM Matthew Ridge changed cell $N$55 from ss to
This will not tell you if someone entered a new line of code into the sheet, but if the code demands an answer, it will tell you what cell that answer is in. This codes below should work for both Mac and PC systems combined. If people find it doesn't please say.
This code was created with the help of people here, and other forms, so I can't take sole proprietorship of the document, but I can take ownership of the concept. So thanks to those who helped, without this there now wouldn't be a viable logging system for Excel in my opinion ;)
BTW, before anyone freaks out and asks where does this code go, it isn't obvious to the general/new end user. You need to go to the Developer Tab open it up, click on Visual Basic, and when the new window opens look for Microsoft Excel Object; under that folder should be your workbook. You can either put it under ThisWorkbook or inside any of the sheets by double clicking on the sheet you want the code to be in.
Once the sheet is open on the right panel, you will see Option Explicit, if you don't it is best if you activate it by making sure the Require Variable Declaration is checked. This is found at the Visual Basic window again, and follow this path:
Tools-> Options -> Editor.
If it is checked then you have no worry, if not then you check it. Option Explicit is a good thing for you code, it forces you to declare variables, which is a good practice to begin with.
After it is verified, you can copy the code below to either paste it in your Workbook, or a specific sheet depending on your needs.
Option Explicit
Dim PreviousValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"
On Error Resume Next ' Turn on error handling
If Target.Value <> PreviousValue Then
' Check if we have an error
If Err.Number = 13 Then
PreviousValue = 0
End If
' Turn off error handling
On Error GoTo 0
sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value
nFileNum = FreeFile ' next file number
Open sLogFileName For Append As #nFileNum ' create the file if it doesn't exist
Print #nFileNum, sLogMessage ' append information
Close #nFileNum ' close the file
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target(1).Value
End Sub
As time goes by, I will attempt to update this code to add more features to it as I deem fit.
Again thanks to all that helped, it is greatly appreciated to make this possible.
The problem is that when the you enter the merged cells, the value put into PreviousValue (in Worksheet_SelectionChange
) is an array of all of the merged cells, which you can't compare to the the new value. When Worksheet_Change
is fired on the edit, the target is only the top-left cell of the merged range. So let's just track that cell for merged ranges. Replace your Worksheet_SelectionChange
with the following:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target(1).Value
End Sub
Disclaimer: This was tested on Excel for Mac 2011 as I don't have access to Excel for Windows at the moment, but I'm pretty sure that it will work on Excel for Windows as well.
Matt Ridge - I know you asked for a solution regarding multiple changes done at once, and i'm only 3 years to late, but here it is :). I've made some slight modifications to the original code, but this will handle merged cells and log multiple changes to cells.
Option Explicit Dim PreviousValue()Private Sub Worksheet_Change(ByVal Target As Range) Dim sLogFileName As String, nFileNum As Long, sLogMessage As String, r As Long
sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt" 'Check all cells for changes, excluding D4 D5 E5 M1 etc For r = 1 To Target.Count If Target(r).Value <> PreviousValue(r) And Intersect(Target(r), Range("D4,D5,E5,M1")) Is Nothing Then ' Check if we have an error If Err.Number = 13 Then PreviousValue(r) = 0 End If ' Turn off error handling 'On Error GoTo 0 'log data into .txt file sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _ & " in " & ActiveSheet.Name & " from " & "'" & PreviousValue(r) & "' to '" & Target(r).Value & "'" & " in workbook " & ThisWorkbook.Path & " " & ActiveWorkbook.Name nFileNum = FreeFile ' next file number Open sLogFileName For Append As #nFileNum ' create the file if it doesn't exist Print #nFileNum, sLogMessage ' append information Close #nFileNum ' close the file End If Next r End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Long 'looks at the uppermost cell (incase cells are merged) Redim PreviousValue(1 To Target.Count) For i = 1 To Target.Count PreviousValue(i) = Target(i).Value Next i End sub
one year later i modified the Code from Matthew - now it tracks changes by copy/paste or tracking down the mouse too, thanks Matthew for the good idea!:
'Paste this into a Module:
Option Explicit
'SheetArray to hold the old values before any change is made
Public aSheetArr() As Variant
'helperfunctions for last row and last col of a given sheet:
Function LastRow(sh As Worksheet)
'get last row of a given worksheet
sh.EnableAutoFilter = False
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
'get last col of a given worksheet
sh.EnableAutoFilter = False
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'Paste this into the workbook_Open method of your workbook (initializing the sheetarray)
Option Explicit
Private Sub Workbook_Open()
Dim lCol As Long
Dim lRow As Long
Dim wks As Worksheet
Set wks = Sheets(1)
lCol = LastCol(wks)
lRow = LastRow(wks)
aSheetArr = wks.Range(wks.Cells(1, 1), wks.Cells(lRow, lCol)) 'read the Range from the whole Sheet into the array
End Sub
'Paste this into the tablemodule - area where you want to log the changes:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'logging all the changes in a worksheet - also the copy/past's and track down's over ceveral cells
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String, r As Long
sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"
'Check all cells for changes, excluding D4 D5 E5 M1 etc
For r = 1 To Target.Count
'compare each cell with the values from the old cell
If Target(r).value <> aSheetArr(Target(r).Row, Target(r).Column) Then
' Check if we have an error
If Err.Number = 13 Then
PreviousValue(r) = 0
End If
' Turn off error handling
'On Error GoTo 0
'log data into .txt file
sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _
& " in " & ActiveSheet.Name & " from " & "'" & aSheetArr(Target(r).Row, Target(r).Column) & "' to '" & Target(r).value & "'"
'set the values in the array to the changed ones
aSheetArr(Target(r).Row, Target(r).Column) = Target(r).value
nFileNum = FreeFile ' next file number
Open sLogFileName For Append As #nFileNum ' create the file if it doesn't exist
Print #nFileNum, sLogMessage ' append information
Close #nFileNum ' close the file
End If
Next r
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With