Tuesday, February 26, 2013

Excel Comments, Part 3

As promised, here is code that works for updating Comments.  It consists of two Subs.

The first uses an Input Box to grab the new comment.  Replacing with a UserForm would allow the following versatility:
  • If entering the information during a meeting, use the name of the person who made the comment.
  • Determine if the new comment is a replacement for all previous comments.
  • Decide if the new comment would go at the top or bottom of the existing comments.
  • Present the current comments, allowing for editing.
  • Put a Type of Comment in the entry, e.g. "Action Item" or "Status"
The second sub either inserts the new comment at the front of the Comments or appends it at the end, based on the Boolean parameter "Insert" passed from the calling Sub.

Sub AddComment()
    AddToComment _
        rngC:=ActiveCell, _
        NewInfo:=InputBox("What?"), _
        C_auth:=Application.UserName, _
        Insert:=False ' Change Insert to "True" to put the most recent comment on top
End Sub

Private Sub AddToComment(rngC As Range, _
                                  NewInfo As String, _
                                 Optional C_auth As String = "", _
                                 Optional Insert As Boolean = False)

    ' The use of "NewComment" is to allow a single point of creating the Comment to be added and allow for adding to the comment
    Dim NewComment As String
    NewComment = Month(Now()) & "/" & Day(Now()) & "/" & Year(Now()) & ": " _
                    & NewInfo & IIf(Len(C_auth) > 0, " (" & C_auth & ")", "")
 
    If rngC.Comment Is Nothing Then ' Handles situations when there is currently no comment
        rngC.AddComment (NewComment)
    Else
        If Insert Then 'Determines whether NewComment become the first entry in the Comment or the last.
            rngC.Comment.Text Text:=NewComment & Chr(10), _
                               Overwrite:=False 'Chr(10) ensures each comment has its own line
        Else ' Append
            rngC.Comment.Text Text:=Chr(10) & NewComment, _
                              Start:=Len(rngC.Comment.Text) + 1 ' "+1" puts NewComment after existing comment
                           
        End If
    End If
End Sub

No comments:

Post a Comment