Auto-Add New Comment to Cell With Content

[default_name]

Hello!

Is there a way to automatically add a comment to a cell within a certain range if the cell has content?
Here is an example of what I mean...(I cant share the actual content, so hopefully this example explains my idea)

I set up a calendar to keep track of food that is eaten.
If a person eats breakfast, then the Breakfast box for that day is checked and a comment is added to that cell so that the user may input what was eaten for breakfast.
In this table, for example, the person ate Breakfast on Monday (as shown by the non-blank cell). In the Monday Breakfast cell I would want a New Comment to be added so that the user may input the foods that were eaten. I do not want comments to be added to the cell if they are blank (Monday Lunch for example). I would only want these behaviors to take place in cells B2:H4 (in the example shown).

	A	B	C	D	E	F	G	H
1		Sun	Mon	Tue	Wed	Thu	Fri	Sat
2	Breakfast		x	x			x
3	Lunch	x		x		x		x
4	Dinner	x	x	x	x	x	x

<tbody>
</tbody>

I hope that makes sense.
Thanks in advance for your help and let me know if I need to clarify anything.

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter an "x" in any cell in B2:H4. and exit the cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2:H4")) Is Nothing Then Exit Sub
    Dim response As String
    response = InputBox("Please enter what you had for " & Cells(Target.Row, 1) & " separated by commas.")
    Target.AddComment response
End Sub

 

[JoeMo]

This version offers a bit more flexibility to the user than the code Mumps posted. The user can delete an "x" and the cell comment is removed. The user can copy/paste multiple x's and each cell receiving a paste will prompt the user to enter a comment.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, c As Range, Cmnt As String
Set R = Range("B2:H4")
If Not Intersect(Target, R) Is Nothing Then
    Application.EnableEvents = False
    For Each c In Intersect(Target, R)
        If c.Value = "" Then c.ClearComments
Again:      If LCase(c.Value) = "x" Then
            If c.Comment Is Nothing Then
                Cmnt = InputBox("Enter a comment for cell " & c.Address(0, 0), "INPUT REQUIRED")
                If Cmnt = "" Then
                    Application.EnableEvents = True
                    Exit Sub
                End If
                c.Addcomment
                c.Comment.Text Text:=Cmnt
            Else
                c.ClearComments
                GoTo Again
            End If
        End If
    Next c
End If
Application.EnableEvents = True
End Sub

 

[default_name]

Thanks guys!!

The prompt code makes it even better!