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