Adding a cell comment with a value from another cell

Question

Hello there,

I have some data filled out in a format similar to the below. I would like to be able to have a comment displayed on cell A2 based on the value in cell XX2 and then for cell B2 I'd like the comment to be the value from XY2. The values in column A vary and can increase and decrease in quantity so one week it may show 3 items and the next week it may show 10 so I'd like it to be scalable vertically if possible by some sort of "lastrow" option.

The data on each row changes frequently so I understand that the macro will like need to clear the results every time it is ran and then repopulate accordingly.

	A	B	XX	XY
1	Delivery Item	Delivery Time	Delivery Item Status	Delivery Time Status
2	Shoes	09:00	Delivered	On time
3	Tshirts	10:00	Delivered	On time
4	Ties		Not delivered	Late
5
6

Is this something that is feasible?

Answer 1

OOPS,

Missed the bit about autosize, try this one.

Sub HasComment()

Dim mycomment As Object, LastRow As Long

Dim c As Range

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For Each c In Range("A2:A" & LastRow)

'Col A

Set mycomment = c.Comment

If mycomment Is Nothing Then

    If Cells(c.Row, "XX") <> "" Then

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

    c.Comment.Shape.TextFrame.AutoSize = True

    End If

Else

    c.Comment.Delete

     If Cells(c.Row, "XX") <> "" Then

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

    c.Comment.Shape.TextFrame.AutoSize = True

    End If

End If

'Col B

Set mycomment = c.Offset(, 1).Comment

If mycomment Is Nothing Then

If Cells(c.Row, "XY") <> "" Then

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

    c.Offset(, 1).Comment.Shape.TextFrame.AutoSize = True

End If

Else

    c.Offset(, 1).Comment.Delete

    If Cells(c.Row, "XY") <> "" Then

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

    c.Offset(, 1).Comment.Shape.TextFrame.AutoSize = True

    End If

End If

Next

End Sub

Answer 2

Thanks very much. :)

If I wanted to extend it horizontally to include C and add comments to C from column XZ would I just need to change the offset to "(, 2)"? I did give this a go but got an error of "Object variable or With block variable not set". Any ideas on that one?

Answer 3

Works perfectly and is easy to expand horizontally thanks to the offset option. Thank you very much.

Is there any way to have it ignore blanks? So at the moment if there is no value in XX it still adds a comment but it's blank. Is there any way to adjust that so it doesn't add a comment?

Thanks in advance.

Hi,

This version tests if there's text in XX & XY and if there is adds the comments, otherwise no comment is added.

Sub HasComment()

Dim mycomment As Object, LastRow As Long

Dim c As Range

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For Each c In Range("A2:A" & LastRow)

'Col A

Set mycomment = c.Comment

If mycomment Is Nothing Then

    If Cells(c.Row, "XX") <> "" Then

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

    End If

Else

    c.Comment.Delete

     If Cells(c.Row, "XX") <> "" Then

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

    End If

End If

'Col B

Set mycomment = c.Offset(, 1).Comment

If mycomment Is Nothing Then

If Cells(c.Row, "XY") <> "" Then

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

End If

Else

    c.Offset(, 1).Comment.Delete

    If Cells(c.Row, "XY") <> "" Then

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

    End If

End If

Next

End Sub

Answer 4

Works perfectly and is easy to expand horizontally thanks to the offset option. Thank you very much.

Is there any way to have it ignore blanks? So at the moment if there is no value in XX it still adds a comment but it's blank. Is there any way to adjust that so it doesn't add a comment?

And also... is there a way to have the comment box automatically resize to fit the contents?

Thanks in advance.

Answer 5

Hi,

Try this. Every time the code is run then all comments in Col A & B are deleted and replaced with new comments from the text in columns XX & XY

Sub HasComment()

Dim mycomment As Object, LastRow As Long

Dim c As Range

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For Each c In Range("A2:A" & LastRow)

'Col A

Set mycomment = c.Comment

If mycomment Is Nothing Then

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

Else

    c.Comment.Delete

    c.AddComment

    c.Comment.Text Cells(c.Row, "XX").Text

End If

'Col B

Set mycomment = c.Offset(, 1).Comment

If mycomment Is Nothing Then

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

Else

    c.Offset(, 1).Comment.Delete

    c.Offset(, 1).AddComment

    c.Offset(, 1).Comment.Text Cells(c.Row, "XY").Text

End If

Next

End Sub