Home » Blogs » Vishesh's blog

Cell Content Change History in Comments

Vishesh's picture
Submitted by Vishesh on 7 February, 2012 - 07:59
Copy the following code in Thisworkbook module.

This will record any cell change in the cell comment. There is a constant at the beginning of the code module; you can set the number of records in comments (history) to be maintained. Specifying 0 means no record limit. This applies to the whole workbook. 

Const gc_intMaxCmtHistory As Integer = 5 'Max Comments History allowed

                                         'Change it to 0 to allow n no. of History items

 
 
Dim PreviousValue
 
 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
    On Error Resume Next
 
    If Target.Cells.Count > 1 Then Exit Sub
 
    If Err.Number <> 0 Then
 
        Err.Clear
 
        Exit Sub
 
    End If
 
    If Target.Value <> PreviousValue Then
 
        Application.EnableEvents = False
 
        If Target.Value <> "" Then
 
            Call AddToComment(Target, Target.Text)
 
        End If
 
        Application.EnableEvents = True
 
    End If
 
End Sub
 
 
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 
    On Error Resume Next
 
    If Target.Cells.Count > 1 Then Exit Sub
 
    If Err.Number <> 0 Then
 
        Err.Clear
 
        Exit Sub
 
    End If
 
    On Error GoTo 0
 
    PreviousValue = Target.Value
 
End Sub
 
 
 
Sub AddToComment(rngCell As Range, strVal As String)
 
    Dim cmt         As Comment
 
    Dim shpCmt      As Shape
 
    Dim intCnt      As Integer
 
    Dim arrSplit
 
 
 
    On Error Resume Next
 
        Set shpCmt = rngCell.Comment.Shape
 
    On Error GoTo 0
 
 
 
    If shpCmt Is Nothing Then
 
        rngCell.AddComment strVal
 
        GoTo ExitEarly
 
    Else
 
        Set cmt = rngCell.Comment
 
        cmt.Text Text:=strVal & Chr(10) & cmt.Text
 
    End If
 
    If gc_intMaxCmtHistory = 0 Then GoTo ExitEarly
 
    arrSplit = Split(cmt.Text, Chr(10))
 
    If (UBound(arrSplit, 1) + 1) > gc_intMaxCmtHistory Then
 
        For intCnt = LBound(arrSplit, 1) To (UBound(arrSplit, 1) - 1)
 
            If intCnt = LBound(arrSplit, 1) Then
 
                cmt.Text Text:=arrSplit(intCnt)
 
            Else
 
                cmt.Text Text:=cmt.Text & Chr(10) & arrSplit(intCnt)
 
            End If
 
        Next intCnt
 
    End If
 
    Erase arrSplit
 
ExitEarly:
 
    Set cmt = Nothing
 
    Set shpCmt = Nothing
 
End Sub
»