Macro to Audit Trail a Specific Sheet

[legalhustler]

Hello VBA Gurus!

I want to keep a track of any changes (doesn't necessarily have to track any formatting changes) to a specific sheet in a separate sheet called "Log". I found the following code that almost does what I want but I would like to break the attributes in different columns instead of one cell. I need the following fields in this specific order:

1) Computer Name - currently it uses the Excel application name, but I need the computer name. I think code is supposed to use the Environ function to do that.
2) Cell - this is the cell that is being changed, should be relative cell reference like B2 and not $B$2
3) Previous Amount - should use "$" sign and comma for each number unit. For negatives it should be use the parenthesis format i.e. "$ (xxx,xxx).
4) Current Amount - See above. If the amount gets deleted then the current amount should show a blank.
5) Date - date of change i.e. 7/26/2021
6) Time - time of change i.e. 12:53 PM (no need to put the seconds)

Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> PreviousValue Then
Sheets("Log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value & " at: " & Time & " on: " & Date
End If
End Sub

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

Any help is appreciated. TIA!

 

[Crystalyzer]

this should give you what you are looking for in columns A - F in the Log worksheet. If you want to adjust the columns simply increment the numbers 1-6 under the "With Sheets("Log")" next to the "nxtRow" statement.

Dim PreviousValue As Variant

Private Sub Worksheet_SelectionChange(ByVal t As Range)
    PreviousValue = t.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
            Dim nxtRow As Long
            
            nxtRow = Worksheets("Log").Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            If Target.Value <> PreviousValue Then
                With Sheets("Log")
                    .Cells(nxtRow, 1).Value = Environ$("computername")
                    .Cells(nxtRow, 2).Value = Replace(Target.Address, "$", "")
                    With .Cells(nxtRow, 3)
                        .Value = PreviousValue
                        .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
                    End With
                    If Target.Value = "" Then
                        .Cells(nxtRow, 4).Value = ""
                    Else
                        With .Cells(nxtRow, 4)
                            .Value = Target.Value
                            .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
                        End With
                    End If
                    .Cells(nxtRow, 5).Value = DateSerial(Year(Now()), Month(Now()), Day(Now()))
                    .Cells(nxtRow, 6).Value = TimeSerial(Hour(Now()), Minute(Now()), 0)
                End With
            End If
End Sub

 

[legalhustler]

Awesome - just a small change request, there is no decimal amount so would like the code to remove the cents (i.e. $10 and not $10.00) if there is none otherwise include it if there is for both the Previous and Current Amount columns. Also, anyway to remove the seconds for the Time column? I want to see 2:13 AM instead of 2:13:00 AM.

Thank you!

 

[Crystalyzer]

Done

Private Sub Worksheet_Change(ByVal Target As Range)
            Dim nxtRow As Long
            
            nxtRow = Worksheets("Log").Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            If Target.Value <> PreviousValue Then
                With Sheets("Log")
                    .Cells(nxtRow, 1).Value = Environ$("computername")
                    .Cells(nxtRow, 2).Value = Replace(Target.Address, "$", "")
                    With .Cells(nxtRow, 3)
                        .Value = PreviousValue
                        If InStr(1, CStr(.Value), ".", vbTextCompare) <> 0 Then
                            .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
                        Else
                            .NumberFormat = "$#,##0_);[Red]($#,##0)"
                        End If
                    End With
                    If Target.Value = "" Then
                        .Cells(nxtRow, 4).Value = ""
                    Else
                        With .Cells(nxtRow, 4)
                            .Value = Target.Value
                            If InStr(1, CStr(.Value), ".", vbTextCompare) <> 0 Then
                                .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
                            Else
                                .NumberFormat = "$#,##0_);[Red]($#,##0)"
                            End If
                        End With
                    End If
                    .Cells(nxtRow, 5).Value = DateSerial(Year(Now()), Month(Now()), Day(Now()))
                    With .Cells(nxtRow, 6)
                        .Value = TimeSerial(Hour(Now()), Minute(Now()), 0)
                        .NumberFormat = "hh:mm AM/PM"
                    End With
                End With
            End If
End Sub

 

[legalhustler]

There is a small issue - when I insert or delete a row/column it gives a debug error message. Also, when I change/enter an amount then immediately delete it it doesn't record it in the log sheet.

 

[legalhustler]

Sorry for the follow ups, is it also possible for me to click undo/redo and log to update? Currently it doesn't allow me when click the undo/redo button (it's greyed out).

 

[Crystalyzer]

I've prevented the deleting a row or column from giving the error, but I have not been able to capture the deletion or insertion in the log. Unfortunately I do not know a way to give you back the undo\redo functionality as it is not possible with some vba solutions within excel.

for the immediate deleting of an entry NOT showing up in the log, the "PreviousValue" relies on the Selection Change event to capture it. If you are not changing the selection, it may not register in the log.

 

[legalhustler]

The code gives an error when I try to delete a row or column. I don't really need the log to capture the deletion/addition of rows/columns. I do need the log to capture if make any changes to values. So if I input an amount in cell B10 then change it back immediately, that should be captured. Is this possible?

Your latest code didn't put the Previous Amount only the Current Amount in the log. Did you change something regarding that?

 

[Crystalyzer]

how are you deleting rows and columns? Manually by selecting the row or column or some other method?

Also, as I said in my last post, the PreviousValue parameter relies on the "Selection Change" event so if you do NOT change the selected cell, it has no way of knowing what the PreviousValue is.

for example

1. If cell A1 is the selected cell
2. You do NOT change the selected cell to another cell
3. You input a new value in cell A1
4. The audit will ONLY have the NEW value and enter it in the log

 

[legalhustler]

how are you deleting rows and columns? Manually by selecting the row or column or some other method?

Also, as I said in my last post, the PreviousValue parameter relies on the "Selection Change" event so if you do NOT change the selected cell, it has no way of knowing what the PreviousValue is.

for example

1. If cell A1 is the selected cell
2. You do NOT change the selected cell to another cell
3. You input a new value in cell A1
4. The audit will ONLY have the NEW value and enter it in the log

I highlight a row/column and right click delete and the error debug message pops.

I’m selecting different cells in my specified sheet and changing many numbers but the log only records the current amount not the previous amount. Your first code puts the previous and current amounts, the second only does the latter. Try it yourself, including deleting the row/column issue.