Log changes to multiple cells (VBA)

[SudLorSeeYeak]

I am using this script below to record log to the sheet name "Log Record". The scrip will record 6 informations to six rows in the "Log Record" sheet when information in active sheet is changed (Cell changed, Sheet changed, Date/Time, User, Old value, New Value). It works fine when new value is put into single cell. However, when new values are pasted onto multiple ceIls, the 'Cell changed' will give range of cell changed in single line.

For example, if I made changes to cell A23, A24, A25 one cell at a time, 3 new lines appear in the "Log Record" sheet showing 3 old and new values input into the 3 cells. However, if I pasted 3 new values from another file to cell A23, A24, A25 in single paste, only one new line appear in the "Log Record" sheet showing I made changes to A23:A25 with only one single new value (but i changed 3 values in 3 cells).

I got this script from our IT and don't really know how I can modify it. Can anyone help modify the script so the it will log all changes made to multiple cells? The script are as below.


Dim PreviousValue As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Sheets("Log Record")
.Unprotect Password:="XXX"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
.Protect Password:="XXX"
End With
End Sub

 

[mumps]

Try this code. If you are pasting more than one value into column A, you will have to highlight the range into which you want to paste. For example, if you want to paste 3 new values from another file to cells A23, A24, A25 in a single paste, select the range A23:A25 and then do the pasting.

Dim PreviousValue As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    Dim i As Long
    PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, x As Long, i As Long: i = 1
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    With Sheets("Log Record")
        .Unprotect Password:="XXX"
        If Target.Count = 1 Then
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 6).Value = Array(Target.Address(False, False), ActiveSheet.Name, Now, Environ("username"), PreviousValue, Target.Value)
        Else
            For Each rng In Target
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 6).Value = Array(rng.Address(False, False), ActiveSheet.Name, Now, Environ("username"), PreviousValue(i, 1), rng.Value)
                i = i + 1
            Next rng
        End If
        .Protect Password:="XXX"
    End With
End Sub

 

[SudLorSeeYeak]

Hi mumps,

Thank you for helping. I try the code but I changed the (Target, Range("A:A") to (Target, Range("A1:DW400") as I want it to record other columns too. Now its showing lots of error when I try pasting different ways (across row/colums) even by selecting the range of cells before pasting. It also give error when deleting values and editing previous values also doesn't show up in Log sheet. Any suggestion would be great. Thank you.

PT

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).