How to make an external log using Excel VBA?

Question

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

Answer 1

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.

Answer 2

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

Answer 3

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