VBA Code - Trying to Index Cell Comments

[sparky_n_ames]

I am needing help with a solution for a worksheet I have.

I have a worksheet that has user fillable cells from B11-AR53. I want the user to be able to attach comments to cells and then to be able to print them on secondary sheet. I know that excel already can perform this function, but it references the cell address and I don't like that method. I want to have the comments on the printout indexed and tied to an index number in the cell. Creating another worksheet with the comments only is perfectly fine. I am currently using this formula (below) to index the comments on the worksheet that they are attached to. It works great, but I need help from here, because I don't know vba well enough to accomplish what I am trying to do. Can anyone help with this?

Ideally my report/second worksheet would list-

1 - Comment that is indexed as 1 would be here
2 - Comment that is indexed as 2 would be here
....and so forth

Sub CoverCommentIndicator()
Dim ws As Worksheet
Dim cmt As Comment
Dim lCmt As Long
Dim rngCmt As Range
Dim shpCmt As Shape
Dim shpW As Double 'shape width
Dim shpH As Double 'shape height


Set ws = ActiveSheet
shpW = 10
shpH = 8
lCmt = 1


For Each cmt In ws.Comments
Set rngCmt = cmt.Parent
With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt
.Name = "CmtNum" & .Name
With .Fill
.ForeColor.SchemeColor = 9 'white
.Visible = msoTrue
.Solid
End With
With .Line
.Visible = msoTrue
.ForeColor.SchemeColor = 64 'automatic
.Weight = 0.25
End With
With .TextFrame
.Characters.Text = lCmt
.Characters.Font.Size = 5
.Characters.Font.ColorIndex = xlAutomatic
.MarginLeft = 0#
.MarginRight = 0#
.MarginTop = 0#
.MarginBottom = 0#
.HorizontalAlignment = xlCenter
End With
.Top = .Top + 0.001
End With
lCmt = lCmt + 1
Next cmt


End Sub

 

[StephenCrump]

It looks like you've adapted some code from another source, and I am not clear how this code relates to the question ...

It sounds like you simply need to list all the comments? If so, the code below lists, in Sheet2, all the comments in Sheet1. Is this what you need?

Sub ListComments()

    Dim lCount As Long, i As Long
    Dim sComments() As String
    Dim shtToCheck As Worksheet
    
    Set shtToCheck = Sheets("Sheet1")
    lCount = shtToCheck.Comments.Count
    If lCount = 0 Then Exit Sub
    ReDim sComments(1 To lCount, 1 To 2)
    
    With shtToCheck.Comments
        For i = 1 To lCount
            sComments(i, 1) = i
            sComments(i, 2) = .Item(i).Text
        Next i
    End With
    
    Sheets("Sheet2").Range("A1").Resize(lCount, 2) = sComments

End Sub

 

[sparky_n_ames]

Stephen thank you for the reply. Yes the code I have listed above is from another source. When I run it on my sheet after adding cell comments it "indexes" the cell comments by putting a number in the upper right corner of the cell and gives each cell with a comment a number. It basically starts with the first cell with a comment as 1, then the next cell containing a comment as two and so forth. This gets me half of what I need, so that is the reason I posted it.

What I want is the worksheet that prints out to be tied to those comments by the number in the cell so I know what comment belongs to what cell. Using the cell address doesn't benefit me because I am printing out the main primary sheet without column and row headings.

another option would be to name the each cell with comment and merge the column label and row label to create a unique identifier that would print on another worksheet that ties the comment to a cell on the primary worksheet. Example ta

Sorry if it seems confusing. Basically using a basic cell addresses to figure out what cell a comment belongs to is not what I want.

i know some VBA but this is above my ability to figure out from scratch.

 

[StephenCrump]

Still not 100% clear, maybe I'm being a bit thick ...

You have the option in Page Setup to print comments "as displayed on sheet". One little glitch with this is that Excel doesn't print the little red triangles in the commented cells, so it may not be totally clear which cell the comment relates to. Debra Dalgleish's Contextures website has a work-around for this ... it looks like you've adapted this code?

But rather than showing the whole comment, you want to show an index number only. Perhaps space is an issue?

Presumably my Sub ListComments provides a satisfactory key, but your issue is how to "tie" each indexed comment to the relevant cell. I take this to mean you want the printout to provide pointers similar to those used to show comments?

One approach to consider ...

1. Temporarily replace the text in each comment with "1", "2" etc, and resize smaller.
2. Get Excel to print these indexed comments "as displayed on sheet", with red triangles (if required) courtesy of Contextures' code.
3. Print a separate key using my Sub ListComments.
4. Restore comments to original text/sizes.

This would be reasonably straighforward to code. But will it meet your requirements?

 

[sparky_n_ames]

Ok after a little more thought and studying up on VBA code, I think what I am trying to accomplish is to assign a name to the cell that the comment is in. So if you run the code below the first cell it comes across it places a little box with 1 in the upper right corner, then it assigns the name "1" to the cell. Then on another worksheet to print the comments, I can print the name in the left column in order and the cell comments to the right. That way you know that the comment printed belongs to the cell with the 1 in the upper right corner.

What doesn't work for me is how Excel prints the comments - As an example- Cell C5 Comment: I don't like this. What I want it to read is Comment #1:Spoke with the user and they won't be able to help with this project

See what I have added below, but I can't seem to get it to work. I still get an 1004 error when I get to the .name line.

Sub CoverCommentIndicator()
Dim ws As Worksheet
Dim cmt As Comment
Dim Cmt1 As Long
Dim rngCmt As Range
Dim shpCmt As Shape
Dim shpW As Double 'shape width
Dim shpH As Double 'shape height
Dim celln As Long
Dim cellname As String
Dim commentn As Long




Set ws = ActiveSheet
shpW = 10
shpH = 8
Cmt1 = 1
commentn = 1


For Each cmt In ws.Comments
Set rngCmt = cmt.Parent
With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt
.Name = "CmtNum" & .Name
With .Fill
.ForeColor.SchemeColor = 9 'white
.Visible = msoTrue
.Solid
End With
With .Line
.Visible = msoTrue
.ForeColor.SchemeColor = 64 'automatic
.Weight = 0.25
End With
With .TextFrame
.Characters.Text = Cmt1
.Characters.Font.Size = 5
.Characters.Font.ColorIndex = xlAutomatic
.MarginLeft = 0#
.MarginRight = 0#
.MarginTop = 0#
.MarginBottom = 0#
.HorizontalAlignment = xlCenter
End With
.Top = .Top + 0.001
End With
'celln = commentn


cellname = CStr(Cmt1)




With ThisWorkbook

.Names.Add Name:="Comment #" & cellname, RefersTo:=ActiveCell

End With


Cmt1 = Cmt1 + 1


Next cmt

 

[StephenCrump]

Try this quick fix for the immediate problem ...

1. Replace:

With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt
.Name = "CmtNum" & .Name

with

With rngCmt
    .Name = "CmtNum" & Cmt1
    Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
        rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt

2. Delete this block:

' cellname = CStr(Cmt1)
'
' With ThisWorkbook
'
' .Names.Add Name:="Comment #" & cellname, RefersTo:=ActiveCell
'
' End With

This names the cells with comments: CommentNo1, CommentNo2 etc. Obviously these names can't contain spaces, e.g. "Comment No 1" or invalid characters e.g. "Comment#1".

I think that's the only two changes. In case I've missed something, here's the complete code that works for me:

Sub CoverCommentIndicator()
    
    Dim ws As Worksheet
    Dim cmt As Comment
    Dim Cmt1 As Long
    Dim rngCmt As Range
    Dim shpCmt As Shape
    Dim shpW As Double 'shape width
    Dim shpH As Double 'shape height
    Dim celln As Long
    Dim cellname As String
    Dim commentn As Long
    
    Set ws = ActiveSheet
    shpW = 10
    shpH = 8
    Cmt1 = 1
    commentn = 1
    
    Dim cmtNo As Long
    
    For Each cmt In ws.Comments
        Set rngCmt = cmt.Parent
        With rngCmt
            .Name = "CmtNum" & Cmt1
            Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
                rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
        End With
        With shpCmt
            With .Fill
                .ForeColor.SchemeColor = 9 'white
                .Visible = msoTrue
                .Solid
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.SchemeColor = 64 'automatic
                .Weight = 0.25
            End With
            With .TextFrame
                .Characters.Text = Cmt1
                .Characters.Font.Size = 5
                .Characters.Font.ColorIndex = xlAutomatic
                .MarginLeft = 0#
                .MarginRight = 0#
                .MarginTop = 0#
                .MarginBottom = 0#
                .HorizontalAlignment = xlCenter
            End With
            .Top = .Top + 0.001
        End With
        'celln = commentn
        
        
'        cellname = CStr(Cmt1)
'
'        With ThisWorkbook
'
'        .Names.Add Name:="Comment #" & cellname, RefersTo:=ActiveCell
'
'        End With
        
        Cmt1 = Cmt1 + 1
        
    Next cmt

End Sub