Also capture username within this VBA action

[nparsons75]

Hi,

I am using VBA code to track changes to an excel spreadsheet, currently recording

Cell changed ref
Old Value
New Value
Time of change
Date of Change

I need to add

Who changed it (Windows username).

The code I need to add to is below, would be great if someone could assist with this, thanks in advance.

Option Explicit

Dim vOldVal 'Must be at top of module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next




    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With




    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
    With Sheet2
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
            .Range("A1:E1") = Array("CELL CHANGED", _
                    "OLD VALUE", _
            "NEW VALUE", "TIME OF CHANGE", "DATE OF Change ")
        End If




        With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
        .Value = Target.Address
        .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
            .ClearComments
            .AddComment.Text Text:= _
                "OzGrid.com:" & Chr(10) & "" & _
                            Chr(10) & _
                "Bold values are the results of formulas "
              End If
            .Value = Target
            .Font.Bold = bBold
            End With




        .Offset(0, 3) = Time
        .Offset(0, 4) = Date
        End With
        .Cells.Columns.AutoFit
        '.Protect Password:="Secret"
    End With
    vOldVal = vbNullString




    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With




On Error GoTo 0
End Sub




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 vOldVal = Target
End Sub

 

[Jerry Sullivan]

You can make these two changes...

     .Offset(0, 3) = Time
     .Offset(0, 4) = Date
     [B].Offset(0, 5) = Application.UserName[/B]

and for the headings...

If .Range("A1") = vbNullString Then
[B]    .Range("A1:E1") = Array("CELL CHANGED",  "OLD VALUE",  _
            "NEW VALUE", "TIME OF CHANGE", "DATE OF Change ",  _
            "USERNAME")[/B]
End If