VBA audit trail - old value not archive

[Flashback]

Hello,

im using this code for audit trail, but he is not archive old value. For example when I changed 5 to 10. In log I will have new value only.

Could you help me please? Im total newb in VBA.

Thank you!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rw As Long
Dim strAddress As String
Dim strUserName As String
Dim dtmTime As Date
Dim val As Variant


If Intersect(Target, Range("A:M")) Is Nothing Then Exit Sub


dtmTime = Now()
val = Target.Value
strAddress = Target.Address
strUserName = Environ("UserName")
Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("Log Sheet")

.Cells(Rw, 1) = strUserName
.Cells(Rw, 2) = strAddress
.Cells(Rw, 3) = val
.Cells(Rw, 4) = dtmTime

End With
End Sub

 

[jkpieterse]

Like so:

Option Explicit

Private mvOldValues As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rw As Long
    Dim strAddress As String
    Dim strUserName As String
    Dim dtmTime As Date
    Dim val As Variant
    Dim lRow As Long
    Dim lCol As Long
    Dim vNewVal As Variant
    If Intersect(Target, Range("A:M")) Is Nothing Then Exit Sub
    'More than one cell may be affected!!!
    vNewVal = Target.Value
    If Target.Cells.Count > 1 Then
        Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row
        For lRow = LBound(mvOldValues, 1) To UBound(mvOldValues, 1)
            For lCol = LBound(mvOldValues, 2) To UBound(mvOldValues, 2)
                If vNewVal(lRow, lCol) <> mvOldValues(lRow, lCol) Then
                    Rw = Rw + 1
                    With Sheets("Log Sheet")
                        .Cells(Rw, 1) = strUserName
                        .Cells(Rw, 2) = strAddress
                        .Cells(Rw, 3) = mvOldValues(lRow, lCol)
                        .Cells(Rw, 4) = vNewVal(lRow, lCol)
                        .Cells(Rw, 5) = dtmTime
                    End With
                End If
            Next
        Next
    Else
        dtmTime = Now()
        val = Target.Value
        strAddress = Target.Address
        strUserName = Environ("UserName")
        Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
        With Sheets("Log Sheet")
            .Cells(Rw, 1) = strUserName
            .Cells(Rw, 2) = strAddress
            .Cells(Rw, 3) = mvOldValues
            .Cells(Rw, 4) = vNewVal
            .Cells(Rw, 5) = dtmTime
        End With
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    mvOldValues = Target.Value
End Sub

 

[Flashback]

Thank you!

And is possible exclude changes of blank cells?

And this not code not work, when value is copied.. is it possible?

Thank you very much!

 

[jkpieterse]

Change this line:

If vNewVal(lRow, lCol) <> mvOldValues(lRow, lCol) Then

to:

If vNewVal(lRow, lCol) <> mvOldValues(lRow, lCol) And Len(mvOldValues(lRow, lCol)) > 0 Then

Not sure what you mean code not work when value is copied, can you describe the EXACT steps?

 

[Flashback]

When im copy value to multiple cell I receive this log https://pasteboard.co/HK4r195.jpg

Only value which was wrote have all information in log

Thank you!