VBA add current date and username when edits are made

michaeltsmith93

Board Regular
Joined
Sep 29, 2016
Messages
83
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]

Code:
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
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top