tracking worksheet changes over multiple columns

[CharlieG]

Hi Everyone,

having to find a way to log who changes any cell on a worksheet and have got myself the following code:


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Target.Offset(0, 7) = Application.UserName & ";" & Now
End If

End Sub


Works great for any change in Column 1 but the issue i have is that there are several columns of data and am wondering whether it could be expanded to columns 1 thru 6?

Any suggestions gratefully received

thank you

[Logit]

.
This requires a sheet named "TRACKER". The sheet may be hidden.



Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, 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 Sheets("Tracker")
'.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:F1") = Array("Cell Changed", "Old Value", _
"New Value", "Time of Change", "Date of Change", "User")
End If


With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = ActiveSheet.Name & " : " & 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
.Offset(0, 5) = Application.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 Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub


Private Sub test()
Application.EnableEvents = True
End Sub