Track changes made to worksheet

trybbe · #1 01-23-2013, 06:58 AM

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

Code:

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 · #2 02-01-2013, 01:06 AM

Hi trybbe,

Try the following:

Code:

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.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Track Changes doesn't track Change Case changes	wardw	Word	3	10-28-2012 05:31 PM
How to summarise different worksheet to a summary worksheet	samkiewhock	Excel	1	09-06-2012 03:34 AM
"Auto-populating" data-worksheet to worksheet.	meggenm	Excel	4	02-04-2012 02:04 AM
Automatic Copies are being made	Mahina	Word	0	08-22-2006 10:28 AM