VBA Question - Populate Comment with Cell Value from Formula

[bc4240]

I'm in need of some code that will put the values in the cells of Column D into a comment of the associated name in Column B. I do not have room in the worksheet cells to put this info and thought including the information as a comment with the person's name might be a solution.

Column D values will reference a table like that of Columns H and I on another worksheet. Here the Column D formula that I'm using to get the corresponding values for the names in Column B

IFNA(INDEX($H$4:$I$11,MATCH(B4,$H$4:$H$11,0),2),"") does not reference another sheet because it is just and example. It would be great if the VBA code would activate when any name in Column B is changed, thus causing the comment in that changed cell in Column B to clear and then re-populate with the new values generated in Column D. This way the order of the names is irrelevant. Thanks in advance for any help you all can provide.

<tbody>
</tbody>

		IFNA(INDEX($H$4:$I$11,MATCH(B4,$H$4:$H$11,0),2),"")
		↓
Tommy Lee		rocker, pam,			John Holmes	happy, sally, disney, jonny
Billy Mayes		qvc, sale, make money, hawk		Timmy Jones	TJ, golfer, walker
John Holmes		happy, sally, disney, jonny		Billy Mayes	qvc, sale, make money, hawk
Tommy Lee		rocker, pam,			George Jones	country, western, guitar
Brad Bad		bb, bad, arm wrestler			Tommy Lee	rocker, pam,
Arnold Swartz		get to the chopper, I'll be back		Brad Bad	bb, bad, arm wrestler
Timmy Jones		TJ, golfer, walker			Arnold Swartz	get to the chopper, I'll be back
Danny O'Day		Irish, river dancer			Danny O'Day	Irish, river dancer

<tbody>
</tbody>

IFNA(INDEX($H$4:$I$11,MATCH(B4,$H$4:$H$11,0),2),"")

<tbody>
</tbody>

 

[tonyyy]

bc4240,

You might consider the following...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then GoTo errHandler:
If Not Intersect(Columns("B:B"), Target) Is Nothing Then
    On Error GoTo errHandler
    Application.EnableEvents = False
    Dim ws2 As Worksheet
    Dim rng As Range, found As Range
    Dim s As String
    
    Set ws2 = Sheets("Sheet2")
    Set rng = ws2.Range("H1", ws2.Cells(Rows.Count, "I").End(xlUp))
    With Target
        .ClearComments
        Set found = rng.Columns(1).Find(What:=.Value, After:=rng.Cells(1, 1), LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not found Is Nothing And found.Value <> "" Then
            s = found.Offset(0, 1).Value
            .AddComment.Text s
        End If
    End With
End If
errHandler:
    Application.EnableEvents = True
    If Err.Number <> 91 And Err.Number <> 0 Then MsgBox "An error occured at Row " & Target.Row & ", " & Target.Value & _
        vbCrLf & Err.Number & ", " & Err.Description
End Sub

The code should be pasted into the Sheet Module that contains the comments.

Cheers,

tonyyy

 

[bc4240]

Tonyyy,

Thanks so much worked like a charm!!! Nice to have talented people like yourself out there helping.

 

[tonyyy]

You're very welcome...