Log maken voor excel workbook to trace all changes

[Kellydp]

Dim PreviousValue As String ' For Logging
Dim CurrentValue As String  ' For Logging
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    LogChange ("Closed " & ActiveWorkbook.Name)
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    LogChange ("Sheet Printed: " & ActiveWorkbook.Name)
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    LogChange ("Saved " & ActiveWorkbook.Name)
End Sub

Private Sub Workbook_NewChart(ByVal Ch As Chart)
    LogChange ("New Chart Created")
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    LogChange ("New Sheet Created")
End Sub
Private Sub Workbook_Open()
    LogChange ("Opened " & ActiveWorkbook.Name)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    LogChange ("Sheet " & ActiveSheet.Name & " Activated")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    CurrentValue = "" ' Reset the current value
    

    If Sh.Name = "Log" Then Exit Sub

    On Error Resume Next
    If Err.Number = 13 Then
        PreviousValue = 0
    Else
        CurrentValue = Target.Value
    End If
    On Error GoTo 0

    ' If there is no values, don't run the following. This fixed a custom macro to add 10 formatted blank lines in a detail sheet
    If PreviousValue = "" And CurrentValue = "" Then Exit Sub

    If VarType(PreviousValue) = VarType(CurrentValue) Then
        If CurrentValue <> PreviousValue Then
            If Err.Number = 13 Then
               PreviousValue = 0
            End If

            If PreviousValue = "" Then
                PreviousValue = "EMPTY"
            End If
            If CurrentValue = "" Then
                CurrentValue = "EMPTY"
            End If
            LogChange (Target.Address & " changed from " & PreviousValue & " to " & CurrentValue)
          End If
    End If
    PreviousValue = 0
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Err.Number = 7 Then Exit Sub
    
    'Capture the What used to be in the changed cell
    PreviousValue = Target.Value
End Sub

'Log Stuff Function
Public Function LogChange(Optional Message)
    Dim StartTime As Double
    Dim TempArray() As Variant
    Dim TheRange As Range
    
    Application.ScreenUpdating = False
    
    ' How Long Does This Take to Run?
    ' StartTime = Timer

    ' Redimension temporary array
    ReDim TempArray(0, 5)

    ' Which row is this going in?
    lastrow = ActiveWorkbook.Sheets("Log").Range("A2").End(xlDown).Row + 1
        
       
    ' Set the destination range
    FirstCell = "A" & lastrow
    LastCell = "F" & lastrow

    'Store the tracked data in an array
    TempArray(0, 0) = FormatDateTime(Now, vbShortDate)
    TempArray(0, 1) = FormatDateTime(Now, vbLongTime)
    TempArray(0, 2) = Environ$("username")
    TempArray(0, 3) = Environ$("computername")
    TempArray(0, 4) = ActiveSheet.Name
    TempArray(0, 5) = Message

    ' Transfer temporary array to worksheet
    Set TheRange = ActiveWorkbook.Sheets("Log").Range(FirstCell, LastCell)
    TheRange.Value = TempArray

    ' Display elapsed time
    'MsgBox Format(Timer - StartTime, "00.00") & " seconds"
    Application.ScreenUpdating = True
End Function

WHEN I WANT TO USE THIS CODE IN A NEW EXCEL FILE, IT DOES NOT WORK, THERE IS A FAULT ON THIS LINE

' Transfer temporary array to worksheet
Set TheRange = ActiveWorkbook.Sheets("Log").Range(FirstCell, LastCell)
TheRange.Value = TempArray

WHAT IS THE PROBLEM ?
the file is uploaded

 

[HSV]

Hello Kelly.

Try this...

 lastrow = ThisWorkbook.Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

....instead of.

lastrow = ActiveWorkbook.Sheets("Log").Range("A2").End(xlDown).Row + 1

 

[Kellydp]

Log file for track all changes

Nee, lukt nog steeds niet

 

[HSV]

Werkt hier prima in een nieuw bestand.

Heb je een werkblad de naam 'Log' wel meegegeven?

 

[HSV]

Bij die oude coderegel zit jij aan de laatste rij +1 van je werkblad ( rij 1048577, vandaar de fout)

In mijn coderegel wordt dit voor het nieuwe bestand rij 2 (wat goed loopt)