VBA keep changes in comment box

Question

Wright now, I am keeping the last changes of data from a cell, in a comment, with this function:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    val_before = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then
        MsgBox Target.Count & " cells were changed!"
        Exit Sub
    End If

    If Target.Comment Is Nothing Then
        Target.AddComment
        existingcomment = ""
    Else
        existingcomment = Target.Comment.Text & vbLf & vbLf
    End If

    Target.Comment.Text Text:=Format(Now(), "DD.MM.YYYY hh:mm") & ":" & vbLf & Environ("UserName") & _
        " changed " & val_before & Target.Address & " from:" & vbLf & """" & val_before & _
        """" & vbLf & "to:" & vbLf & """" & Target.Value & """"

End Sub

original answer here: VBA Last Change Method

But I am trying to change it, to keep a maximum of 5 history changes in the comment box, and when a new change is made, to delete the oldest one. And I was thinking to do the following operations:

'count the : (double dots-from the time), when is bigger then 5, compare the date and time of the changes, delete the oldest one and log the new one(6th) for example.

Has anyone a better idea? I am new to VBA and also to programming.

Answer 1

So, this is my working version:

Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
   If Target.Row <= 2 Then GoTo EndeSub
   If Not Intersect(Range("C:JA"), Target) Is Nothing Then
     On Error GoTo EndeSub
     Application.EnableEvents = False
     Range("B" & Target.Row) = Now
   End If

    Application.Volatile
    Dim CommentBox As Object
    Set CommentBox = Range("B" & Target.Row).Comment
    Dim CommentString As String

    If Not CommentBox Is Nothing Then
        If CommentBox.Text <> "" Then
            CommentString = CommentBox.Text
            Range("B" & Target.Row).Comment.Delete
        End If
    Else
        CommentString = ""
    End If

    Dim CommentTemp As String
    CommentTemp = CommentString
    Dim LastDoubleDotPosition As Integer
    LastDoubleDotPosition = 0
    Dim LongestName As Integer
    LongestName = 0

    If InStr(CommentTemp, ":") > 0 Then StillTwoDoubleDots = True

    Do While InStr(CommentTemp, ":") > 0


        If InStr(CommentTemp, ":") > LongestName Then LongestName = InStr(CommentTemp, ":")
        CommentTemp = Right(CommentTemp, Len(CommentTemp) - InStr(CommentTemp, ":"))

    Loop

    count = CountChr(CommentString, ":")

    If count >= 5 Then

        LastDoubleDotPosition = Len(CommentString) - Len(CommentTemp) - 1
        CommentString = Left(CommentString, LastDoubleDotPosition - 13)

    End If

    'insert comment
    Dim FinalComment As String
    FinalComment = Format(Now(), "DD.MM.YYYY hh:mm") & " " & "by" & " " & Application.UserName & vbCrLf & CommentString 'newComment and the oldcomment
    Range("B" & Target.Row).AddComment FinalComment

    Set CommentBox = Range("B" & Target.Row).Comment

    LongestName = LongestName * 5
    If LongestName < 150 Then LongestName = 150

    With CommentBox
        .Shape.Height = 60
        .Shape.Width = LongestName
    End With


EndeSub:
    Application.EnableEvents = True

End Sub

'counter
Public Function CountChr(Expression As String, Character As String) As Long

    Dim Result As Long
    Dim Parts() As String
    Parts = Split(Expression, Character)
    Result = UBound(Parts, 1)
    If (Result = -1) Then
    Result = 0
    End If
    CountChr = Result

End Function

Requirements were changed and I keep in the comment box only time&date of changes and the user name.

Answer 2

This is how I would have done it - I assume that the worksheet event is trivial enough, thus I am making a sub-routine, that takes the value from a cell and adds it to the comment, as far as this is the important part.

The allowed number of comments is a constant, defined as NUMBER_OF_COMMENTS. The deliminator is also a constant, DELIM = " >> ".

Once the value in the range is entered, then the sub takes it and adds it to the comment with a loop. I am "entering" in the cell the text Test 00N. It is better seen than explained:

This is how the comment looks like, after inserting 100 values in the cell, keeping only the last 5 in the comments:

As you see, only the last 5 values are taken. If we change NUMBER_OF_COMMENTS to 12, this is what we get:

:

This is how the code looks like:

Public Sub TestMeCaller()        
    Dim cnt As Long        
    For cnt = 1 To 100
        TestMe cnt
    Next cnt        
End Sub

-

Public Sub TestMe(counter As Long)

    Dim rangeWithComment        As Range
    Dim commentText             As String
    Dim commentArray            As Variant
    Dim cnt                     As Long

    Const DELIM = " >> "
    Const NUMBER_OF_COMMENTS = 12

    Set rangeWithComment = Cells(2, 2)
    rangeWithComment = "TEST 00" & counter
    commentText = DELIM & rangeWithComment
    rangeWithComment.ClearContents

    If rangeWithComment.Comment Is Nothing Then
        rangeWithComment.AddComment
        rangeWithComment.Comment.Text (commentText)
        Exit Sub
    Else
        commentArray = Split(rangeWithComment.Comment.Text, DELIM)
    End If

    For cnt = LBound(commentArray) + 1 To UBound(commentArray)        
        If cnt >= NUMBER_OF_COMMENTS Then Exit For
        commentText = commentText & _ 
                      IIf(cnt = 1, vbCrLf, vbNullString) &  DELIM & commentArray(cnt)
    Next cnt

    rangeWithComment.Comment.Text (commentText)

End Sub

This code will be broken, if you start entering values like " >> " in the cell, but this is something you can probably live with.

Answer 3

First off, that's a pretty cool idea :)

Ideally, you would have an array variable with the max. of 5 comments and you would use that array to populate the Comment from scratch each time. However, I can see how that would get a bit complicated, since you're aiming for a general solution supporting all cells. I'm assuming you probably also want the history to persist after closing the worksheet.

A database would of course also be a pretty good application for something like this, but I'm guessing establishing a database connection would be too much work for your purposes.

Having said that... Your suggested approach isn't all that pretty or reliable, but I like it for your purposes. The following need adjustments, though:

• Don't count the colons ("double dot", :). You're definitely going to have more than one of these per comment. Instead, I would probably add a dividing line or something at the end of each comment, like

  Target.Comment.Text = Target.Comment.Text & vbCrLf & "--------------" & vbCrLf
  

  or you could just count for the two vbLf in a row (that you currently have)

• Instead of counting I would probably just split the comment like so:

  comments = Split(Target.Comment.Text, vbLf & vbLf)
  

  That gives you an array (comments) of all the comments that you can then loop through like this:

  For i = 0 to UBound(comments)
      ' do stuff with comments(i) here
  Next
  

Hope that helps, let me know if something's unclear or you have other questions.