Track changes made to worksheet

[trybbe]

Hi, I got the following code from OzGrid.com whi is working fine except I need it to display the name or userid of the person who made the changes.please help

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 Sheet1
  .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

[macropod]

Hi trybbe,

Try the following:

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 Sheet1
  .Unprotect Password:="Secret"
  If .Range("A1") = vbNullString Then
    .Range("A1:F1") = Array("CELL CHANGED", "OLD VALUE", _
      "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE", "USERNAME")
  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:="Bold values are the results of formulas"
      End If
      .Value = Target
      .Font.Bold = bBold
    End With
    .Offset(0, 3) = Time
    .Offset(0, 4) = Date
    .Offset(0, 5) = Environ("Username")
  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

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab. It took quite a while to reformat the code you posted, which was all just one long string.