Subroutine to Add Cell Comments Not Updating the Contents Correctly

Eldrod

Board Regular
Joined
Mar 11, 2010
Messages
76
Hi,

I have a spreadsheet with some named range cells that I want to add a comment to that contains the contents of another named range. The subroutine below seems to work correctly every once in a while, but usually writes the wrong named range to the target cell. I have been hacking on this all day and have still not been able to figure how it writes the incorrect information when provided the correct cell reference.
The code below is a sub that called the WriteCommentTest subroutine and passes the name of the cell that the comment will attach to and the name of the range that contains the text to write in the comment.
If I run this with only one comment call, it usually works OK. But if I call the sub multiple times, it will begin to write null comments and then put the second call text into the third call's cell. I have tried debugging and confirmed that the right target and source cells are selected in each call.
Here is the example of the error output. The First comment cell has the text from Comment2 and Comment2 cell has a null value, while Comment3 cell has the right text.

1707431347270.png



VBA Code:
Sub WriteComments()
   Call DynamicCommentTest("First_Comment", "Comment1_Text")
   Call DynamicCommentTest("Second_Comment", "Comment2_Text")
    Call DynamicCommentTest("Third_Comment", "Comment3_Text")
   End Sub

Sub DynamicCommentTest(CommentCell As String, CommentText As String)
Dim cell As Range
Dim rng As Range
Dim rng2 As Range
Dim strComment As String
Dim Col1, Col2, Col3 As Integer
Dim commentBox As Comment

With ThisWorkbook
    Application.ScreenUpdating = True
    Application.EnableEvents = False

    Set rng = Range(CommentText)
    For Each cell In rng.Rows
        If Len(cell.Cells(1, 1)) > Col1 Then Col1 = Len(cell.Cells(1, 1))
        If Len(cell.Cells(1, 2)) > Col2 Then Col2 = Len(cell.Cells(1, 2))
        If Len(cell.Cells(1, 3)) > Col3 Then Col3 = Len(cell.Cells(1, 3))
    Next cell
    Col1 = Col1 + 1
    Col2 = Col2 + 1
    Select Case Col3
        Case 0 To 3
            Col3 = Col3 + 1
        Case 4 To 6
            Col3 = Col3 + 2
        Case 7 To 9
            Col3 = Col3 + 3
    End Select

    ' Concatenate all the values in the range into a single string
    For Each cell In rng.Rows
        strComment = strComment & _
            cell.Cells(1, 1) & Application.WorksheetFunction.Rept(" ", Col1 - Len(cell.Cells(1, 1))) & _
            cell.Cells(1, 2) & Application.WorksheetFunction.Rept(" ", Col2 - Len(cell.Cells(1, 2))) & _
            Application.WorksheetFunction.Rept(" ", Col3 - Len(Format(cell.Cells(1, 3).Value, "$#,##0"))) & _
            Format(cell.Cells(1, 3).Value, "$#,##0") & vbNewLine
    Next cell

    ' Remove the last newline character
    If Len(strComment) > 0 Then
        strComment = Left(strComment, Len(strComment) - 1)
    End If
    
    ' Add a comment to cell with the concatenated string
    Set rng2 = Range(CommentCell)
    With rng2
        .ClearComments ' Clear any existing comments
        Set commentBox = .AddComment(strComment)
        With .Comment
            .Shape.TextFrame.AutoSize = True
            .Shape.TextFrame.Characters.Font.Name = "Consolas"
        End With
        ' Resize the comment box to fit the text
        .Comment.Visible = False
        commentBox.Shape.TextFrame.AutoSize = True
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End With
Set rng = Nothing
Set rng2 = Nothing
End Sub

Does anyone have any idea why this isn't working? In the actual model. I'm using, the WriteComments sub is called from a Worksheet_Activate, but Is doesn't work correctly when called by a macro button either, so I don't think that's it. Any help or suggestions are greatly appreciated.
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
It would be useful to be able to see your range definitions - can you attach a screenshot of Name Manager with those definitions fully visible?
 
Upvote 0
It would be useful to be able to see your range definitions - can you attach a screenshot of Name Manager with those definitions fully visible?
Here are the Name definitions.
1707445344099.png

In my continuing effort to resolve this, I tried moving the .ClearComments step to the subroutine that called the DynamicContent sub as I noticed that if I manually deleted the note/comment, the macro would usually work successfully the next time.

Here is that update:
VBA Code:
Sub WriteComments()
    'Delete all Comments first
    Range("First_Comment").ClearComments
    Range("Second_Comment").ClearComments
    Range("Third_Comment").ClearComments
    
   Call DynamicCommentTest("First_Comment", "Comment1_Text")
   Call DynamicCommentTest("Second_Comment", "Comment2_Text")
    Call DynamicCommentTest("Third_Comment", "Comment3_Text")
End Sub

And I commented out the .ClearComments in the working subroutine (shown here)
VBA Code:
    Set rng2 = Range(CommentCell)
    With rng2
    'Debug.Print "clear comments on ", CommentCell, Range(CommentCell).Address
  [B] '     .ClearComments ' Clear any existing comments[/B]
        Set commentBox = .AddComment(strComment)
        'Debug.Print "commentaddr=", Range(CommentCell).Address, "comment added for", CommentCell, "tex=", strComment
            'Application.Wait (Now + TimeValue("0:00:01"))
        With .Comment
            .Shape.TextFrame.Characters(TopLineStart, TopLineEnd).Font.FontStyle = "Bold"
            .Shape.TextFrame.Characters(BottomLineStart, BottomLineEnd).Font.FontStyle = "Bold"
            .Shape.TextFrame.AutoSize = True
           ' .Shape.TextFrame.Characters.Font.Name = "Cascadia Code"
            .Shape.TextFrame.Characters.Font.Name = "Consolas"
      '      .Shape.TextFrame.Characters.Font.Name = "Courier New"
        End With
        ' Resize the comment box to fit the text
        .Comment.Visible = False
        commentBox.Shape.TextFrame.AutoSize = True
    End With
So, I thought this corrected the issue, so I made these changed back to the code of the larger model. My main sheet has a worksheet_change sub that calls the WriteComments sub whenever a certain cell is updated. However, the issue of blank comments returns when the sub is called from a worksheet change.
Hope the additional info rings a bell for anyone else that has come across this.
 
Upvote 0
I have run your code many times in debug, without the issues that you mention. However, I did notice that your code uses a variable name of "cell", which is not a good idea as using reserved words can sometimes lead to tearing your hair out. So I changed that in your code, as well as couple of other minor changes. See if this updated code gives you the same problem.
VBA Code:
Sub DynamicCommentTest(CommentCell As String, CommentText As String)
Dim rngRow As Range
Dim rngText As Range
Dim rngComment As Range
Dim strComment As String
Dim Col1, Col2, Col3 As Integer
Dim commentBox As Comment

With ThisWorkbook
    Application.ScreenUpdating = True
    Application.EnableEvents = False

    Set rngText = Range(CommentText)
    For Each rngRow In rngText.Rows
        If Len(rngRow.Cells(1, 1).Value) > Col1 Then Col1 = Len(rngRow.Cells(1, 1).Value)
        If Len(rngRow.Cells(1, 2).Value) > Col2 Then Col2 = Len(rngRow.Cells(1, 2).Value)
        If Len(rngRow.Cells(1, 3).Value) > Col3 Then Col3 = Len(rngRow.Cells(1, 3).Value)
    Next rngRow
    Col1 = Col1 + 1
    Col2 = Col2 + 1
    Select Case Col3
        Case 0 To 3
            Col3 = Col3 + 1
        Case 4 To 6
            Col3 = Col3 + 2
        Case 7 To 9
            Col3 = Col3 + 3
    End Select

    ' Concatenate all the values in the range into a single string
    For Each rngRow In rngText.Rows
        strComment = strComment & _
            Left(rngRow.Cells(1, 1).Value & Space(Col1), Col1) & _
            Left(rngRow.Cells(1, 2).Value & Space(Col2), Col2) & _
            Right(Space(Col3) & Format(rngRow.Cells(1, 3).Value, "$#,##0"), Col3) & _
            vbNewLine
    Next rngRow

    ' Remove the last newline character
    If Len(strComment) > 0 Then
        strComment = Left(strComment, Len(strComment) - 1)
    End If
    
    ' Add a comment to cell with the concatenated string
    Set rngComment = Range(CommentCell)
    With rngComment
        .ClearComments ' Clear any existing comments
        Set commentBox = .AddComment(strComment)
        With .Comment
            .Shape.TextFrame.AutoSize = True
            .Shape.TextFrame.Characters.Font.Name = "Consolas"
        End With
        ' Resize the comment box to fit the text
        .Comment.Visible = False
        commentBox.Shape.TextFrame.AutoSize = True
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End With
Set rngText = Nothing
Set rngComment = Nothing
End Sub
 
Upvote 0
Solution
I have run your code many times in debug, without the issues that you mention. However, I did notice that your code uses a variable name of "cell", which is not a good idea as using reserved words can sometimes lead to tearing your hair out. So I changed that in your code, as well as couple of other minor changes. See if this updated code gives you the same problem.
VBA Code:
Sub DynamicCommentTest(CommentCell As String, CommentText As String)
Dim rngRow As Range
Dim rngText As Range
Dim rngComment As Range
Dim strComment As String
Dim Col1, Col2, Col3 As Integer
Dim commentBox As Comment

With ThisWorkbook
    Application.ScreenUpdating = True
    Application.EnableEvents = False

    Set rngText = Range(CommentText)
    For Each rngRow In rngText.Rows
        If Len(rngRow.Cells(1, 1).Value) > Col1 Then Col1 = Len(rngRow.Cells(1, 1).Value)
        If Len(rngRow.Cells(1, 2).Value) > Col2 Then Col2 = Len(rngRow.Cells(1, 2).Value)
        If Len(rngRow.Cells(1, 3).Value) > Col3 Then Col3 = Len(rngRow.Cells(1, 3).Value)
    Next rngRow
    Col1 = Col1 + 1
    Col2 = Col2 + 1
    Select Case Col3
        Case 0 To 3
            Col3 = Col3 + 1
        Case 4 To 6
            Col3 = Col3 + 2
        Case 7 To 9
            Col3 = Col3 + 3
    End Select

    ' Concatenate all the values in the range into a single string
    For Each rngRow In rngText.Rows
        strComment = strComment & _
            Left(rngRow.Cells(1, 1).Value & Space(Col1), Col1) & _
            Left(rngRow.Cells(1, 2).Value & Space(Col2), Col2) & _
            Right(Space(Col3) & Format(rngRow.Cells(1, 3).Value, "$#,##0"), Col3) & _
            vbNewLine
    Next rngRow

    ' Remove the last newline character
    If Len(strComment) > 0 Then
        strComment = Left(strComment, Len(strComment) - 1)
    End If
  
    ' Add a comment to cell with the concatenated string
    Set rngComment = Range(CommentCell)
    With rngComment
        .ClearComments ' Clear any existing comments
        Set commentBox = .AddComment(strComment)
        With .Comment
            .Shape.TextFrame.AutoSize = True
            .Shape.TextFrame.Characters.Font.Name = "Consolas"
        End With
        ' Resize the comment box to fit the text
        .Comment.Visible = False
        commentBox.Shape.TextFrame.AutoSize = True
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End With
Set rngText = Nothing
Set rngComment = Nothing
End Sub
Thanks for the response and revisions! This issue keeps getting weirder. I made the changes you suggested, and the problem still persists -- on this Windows 11 computer. I copied the spreadsheet to my personal Windows 11 laptop and it works flawlessly every time. But on my work laptop, it works once in a while and posts the incorrect text almost every time I test it. Work computer is running Office 365 Enterprise and personal is running Office 365. Both are up-to-date on upgrades and both laptops are Dells. I checked the Excel options line by line and they're the same. Any clue as to why the code works on one laptop and fails on the other?
 
Upvote 0
There has to be something different in the environment of your work laptop. Can you check for AddIns, and disable them before running the tests again? And can you comment out all other subs and functions in your workbook (including in worksheets and workbook) to see if that gets rid of the problem? (If either works, re-introduce the Addins and subs/functions one at a time to see at what point you get a problem.)
 
Upvote 0
There has to be something different in the environment of your work laptop. Can you check for AddIns, and disable them before running the tests again? And can you comment out all other subs and functions in your workbook (including in worksheets and workbook) to see if that gets rid of the problem? (If either works, re-introduce the Addins and subs/functions one at a time to see at what point you get a problem.)
Thanks! I was finally able to resolve the issue but still not able to explain it. After updating my computer and repairing Office 365 (I don't think that helped any), the issue was occurring so consistently that I was able to trace what was happening. It appears that the
VBA Code:
Set rngComment = Range(CommentCell)
was not always executing (no idea why not). I added a cell select
VBA Code:
rngComment.Select
following the set command and that resolved the issue. Crazy, but that is what it was for this laptop.
 
Upvote 0
I think Murphy owes you a few weeks error-free - that was nasty.
 
Upvote 0

Forum statistics

Threads
1,223,883
Messages
6,175,167
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top