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.
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.
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.
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.