How to create a log sheet which logs certain cells when changed

[sdhutty]

Hi there,

I currently have a log sheet which logs the:

username who made the change (column A)
action (column B)
target cell (column C)
changed to (column D)
date/time it was done (column E)

What I also want is it to log the name and username corresponding to the row that was changed. The changes are logged from a sheet names "AccessGrants"

This sheet has names and usernames in columns D & E. So what i want is when it logs the changes, it reads the row from columns D & E to see the corresponding name and username in regards to the change and records this in columns F & G in sheet 'Log'.

For example:

If a change was made in N20 and logs this. It will also read the name and username in D20 and E20 and log it in columns F & G in sheet 'Log'. Thanks. Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Dim PreviousValue As Variant
Dim Errb As Integer
    Set WorkRng = Intersect(Range("J:J,L:L,N:N,P:P,S:S,U:U,W:W,Z:Z,AB:AB,AD:AD"), Target)
    
    xOffsetColumn = 1
    
    If Not WorkRng Is Nothing Then
        
        Call ProtectSheet(False, "AccessGrants")
        Application.EnableEvents = False
        
        For Each Rng In WorkRng
                Rng.Offset(0, xOffsetColumn) = Environ("Username") & "|" & Format(Now, "dd-mm-yyyy, hh:mm:ss")
        Next Rng
        
        Call ProtectSheet(True, "AccessGrants")
        Application.EnableEvents = True
    End If
Log.Unprotect Password:=Green
On Error GoTo ErrTrap:
    If Target.Value <> PreviousValue Then
      With Sheets("Log").Cells(100000, 1).End(xlUp)
        .Offset(1, 0).Value = Application.UserName
        .Offset(1, 1).Value = "changed cell"
        .Offset(1, 2).Value = Target.Address
        .Offset(1, 3).Value = Target.Value
        .Offset(1, 4).Value = Now()
      End With
    End If
    Exit Sub
ErrTrap:
  ErrNum = Err
  
  If ErrNum = 13 Then
    '*** Multiple cells have been selected, treat them as one merged group*****
    Resume Next
  End If
  Log.Protect Password:=Green
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target.Value
End Sub
Sub reset()
Application.EnableEvents = True
End Sub
Sub demo()

Debug.Print Environ("username")

End Sub

[protonLeah]

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution.

Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.

To change a Title go to your first post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)