VBA add current date and username when edits are made

[michaeltsmith93]

Hi,

I found the below code to add the current date to an adjacent column when an edit is made. Note that this code is meant to apply to the worksheet, which might complicate my bonus question. I'd like to modify it to do the following:

1. Add the date to Column L of the edit row regardless of the column in which the edit is made. I've come to the forum because the current mechanism involves offset, which doesn't work well in this case.
2. Add the username to Column M of the edit row as well. I know that this is just Application.Username, but I'm not sure how to pull that. In addition, if someone could point me in the right direction in terms of using Split to get "First Last" instead of "Last, First," that'd be great.

Bonus points to someone that wants to write some code that automatically adds to a list of all editors with the dates that they made edits on a separate sheet called "Review_Tracker". I would just want it to list one entry for a day of edits by one editor (i.e., if John Doe made edits to three rows on 10-Dec, and Jane Doe made edits to four rows on 10-Dec, it would output the following on the separate sheet). It would be key that this updates as edits are made and maintains the record of old edits since it's possible that an edit might be edited. I want this output to reflect a list of all edits and their dates so as to easily demonstrate how often this document is being reviewed.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Editor[/TD]
[TD]Date of Edits[/TD]
[/TR]
[TR]
[TD]Doe, John[/TD]
[TD]10-Dec-2018[/TD]
[/TR]
[TR]
[TD]Doe, Jane[/TD]
[TD]10-Dec-2018[/TD]
[/TR]
</tbody>[/TABLE]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("K:K")) Is Nothing) Then _
            Target.Offset(0, +1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("K:K"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, +1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[DanteAmor]

I give you the updated code. On the sheet "Review_Tracker", on the column "A" the date, on the B the name, on the C the quantity, on the D the modified cell.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim h2 As Worksheet
    Dim u2 As Long
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Columns("L:M")) Is Nothing Then
        Cells(Target.Row, "L").Value = Date
        Cells(Target.Row, "M").Value = Application.UserName
        Set h2 = Sheets("Review_Tracker")
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        h2.Cells(u2, "A").Value = Date
        h2.Cells(u2, "B").Value = Application.UserName
        h2.Cells(u2, "C").Value = WorksheetFunction.CountIfs(h2.Range("A1:A" & u2), Date, _
                                  h2.Range("B1:B" & u2), Application.UserName)
        h2.Cells(u2, "D").Value = Target.Address(False, False)
    End If
End Sub

Regards Dante Amor

 

[michaeltsmith93]

Thank you, Dante! This is fantastic.

 

[DanteAmor]

With pleasure