The code below leverages some of Nimrod's ideas, corrects a tiny glitch in his code, and keeps the data in cell comments.
The result will look like:
<blockquote>
Owner 11/2/2003 22:27:45: {=TAN(B1:B3*PI())} (-0.1249387366083->-1)
Owner 11/2/2003 22:27:52: (-1->)
Owner 11/2/2003 22:28:03: =LOG(B3:B5) (->-0.1249387366083)
Owner 11/2/2003 22:28:39: =Sheet2!A1 (-0.1249387366083->21)
Owner 11/2/2003 22:33:19: 45.3 (21->45.3)
Owner 11/2/2003 22:33:26: xyz (45.3->xyz)
Owner 11/2/2003 22:38:33: =NOW() (xyz->11/2/2003 22:38:34)
Owner 11/2/2003 22:39:00: =TODAY() (11/2/2003 22:38:34->11/2/2003)</blockquote>
Together with a timestamp, it gives the new formula, together with an indicator if it is an array formula, as well as the old value and the new value. The old value is defined as the value when the cell was selected or when the cell content was modified, whichever was later.
So, it leaves a tiny window where the old value may not be accurate. This window is the following: Suppose you select a cell. Then, use F9 to recalculate the worksheet -- and the recalculation changes the cell value. Now, you change the cell contents. In this case, the reported old value will be the value at the time the cell was selected, not after the recalculation.
In the worksheet module:
Code:
Option Explicit
Dim currUserName As String, LastValue As Variant
Sub AddNewData(aCell As Range, LastValue)
On Error Resume Next
Dim aComment As Comment, CellFormula As String
With aCell
Set aComment = .Comment
On Error GoTo ErrXIT
Application.EnableEvents = False
If aComment Is Nothing Then Set aComment = .AddComment
CellFormula = .Formula
If .HasArray Then CellFormula = "{" & CellFormula & "}"
.Comment.Text .Comment.Text() _
& currUserName & " " & Date & " " & Time() & ": " _
& CellFormula _
& " (" & LastValue & "->" & .Value & ")" & vbLf, 1
End With
ErrXIT:
Application.EnableEvents = True
End Sub
Sub saveValues(Target As Range)
Dim i As Long
ReDim LastValue(1 To Target.Cells.Count)
For i = LBound(LastValue) To UBound(LastValue)
LastValue(i) = Target.Cells(i).Value
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If currUserName = "" Then currUserName = GetUserName()
If InStr(1, TypeName(LastValue), "(") > 0 Then
For i = 1 To Target.Cells.Count
AddNewData Target.Cells(i), LastValue(i)
Next i
Else
For i = 1 To Target.Cells.Count
AddNewData Target.Cells(i), LastValue
'not really sure if LastValue makes sense here ;-)
Next i
End If
saveValues Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
saveValues Target
End Sub
In a normal module:
Code:
Option Explicit
Option Private Module
Private Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
Public Function GetUserName() As String
Dim lpBuff As String
lpBuff = String(255, Chr(0))
Get_User_Name lpBuff, 255
GetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function
If you ask for enhancements, some of which I can already think of, I won't be able to help you. Having spent way more than the budgeted time on this, I have added to an already onerous backlog. Hopefully, someone else will pitch in.
newshound12 said:
Yes, but only shows last change, shares workbook, locks macros for editing.
Your code is better. Still would like to see last couple of changes in cell.
