VBA Last Change Method

Question

I am looking for a function to print in a comment box, who was the users that changed the data from that cell. What I have for now is this:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
   If Not Intersect(Range("C:JA"), Target) Is Nothing Then
     On Error GoTo EndeSub
     Application.EnableEvents = False
     Range("B" & Target.Row) = Now
   End If
EndeSub:
   Application.EnableEvents = True
 End Sub

It "triggers" automatically when someone types something in a cell. And is printing only the last user name that changed the data, but I want to be some kind of a log, to print all the users. Do you think it is possible?

Answer 1

One way is, insert a New Sheet and name it "Log" and place the two headers like this...

On Log Sheet

A1 --> Date/Time

B1 --> User

Now replace your existing code with this...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
    Dim wsLog As Worksheet
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        On Error GoTo EndeSub
        Set wsLog = Sheets("Log")
        Application.EnableEvents = False
        Range("B" & Target.Row) = Now
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
    End If
EndeSub:
   Application.EnableEvents = True
End Sub

So each time any user makes changes in the target range, the time of change and the user name will be listed on Log Sheet.

Edit:

As per the new setup, these column headers should be there on the Log Sheet.

A1 --> Date/Time
B1 --> User
C1 --> Cell
D1 --> Old Value
E1 --> New Value

Then replace the existing code with the following two codes...

Dim oVal
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
    Dim wsLog As Worksheet
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        On Error GoTo EndeSub
        Set wsLog = Sheets("Log")
        Application.EnableEvents = False
        Range("B" & Target.Row) = Now
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 2) = Target.Address(0, 0)
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 3) = oVal
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 4) = Target.Value
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
    End If
EndeSub:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        oVal = Target
    End If
End Sub

Answer 2

Another bit of code to give you some ideas:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    val_before = Target.Value

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then
        MsgBox Target.Count & " cells were changed!"
        Exit Sub
    End If

    If Target.Comment Is Nothing Then
        Target.AddComment
        existingcomment = ""
    Else
        existingcomment = Target.Comment.Text & vbLf & vbLf
    End If

    Target.Comment.Text Text:=Format(Now(), "yyyy-mm-dd") & ":" & vbLf & Environ$("Username") & _
        " changed " & Target.Address & " from:" & vbLf & """" & val_before & _
        """" & vbLf & "to:" & vblkf & """" & Target.Value & """"

End Sub

Any time a cell is selected, it stores the cell's existing value in a variable. If the cell is changed, it creates a new comment in the cell (or appends the existing comment if there is one) with the date, username, cell address, and the "before and after" values. This could be super annoying if someone's trying to make a lot of changes, and if there are multiple changes at once, then it will just warn you without creating a comment. I'd suggest you practice on a blank workbook (or a 2nd copy of the one you're working on) in case there are any problems. Be sure to Google any of the properties/methods than you are unfamiliar with, for the sake of learning, and for building a solution to fit your needs!

Answer 3

In a Public Module

Sub LogChange(Target As Range)
    Dim cell As Range, vNew As Variant, vOld As Variant
    vNew = Target.value
    Application.Undo
    vOld = Target.value
    Target.value = vNew
    With getLogWorksheet
        With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
            '                     Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
            .Resize(1, 6).value = Array(Now, Environ("UserName"), Target.Parent.Name, Target.Address(False, False), vOld, vNew)
        End With
    End With
End Sub

Private Function getLogWorksheet() As Workbook
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Log")
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add
        ws.Visible = xlSheetVeryHidden
        ws.Name = "Log"
        ws.Range("A1").Resize(1, 6).value = Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
    End If
End Function

In a Worksheet Module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then
        Application.Undo
        MsgBox "Changing more than 1 cell at a time is prohibited", vbCritical, "Action Undone"
    ElseIf Not Intersect(Range("C:JA"), Target) Is Nothing Then
        LogChange Target
    End If
End Sub