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

[TABLE="width: 814"]
<tbody>[TR]
[TD="colspan: 6"]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.[/TD]
[/TR]
</tbody>[/TABLE]


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

[TABLE="width: 814"]
<tbody>[TR]
[TD="colspan: 6"]IFNA(INDEX($H$4:$I$11,MATCH(B4,$H$4:$H$11,0),2),"")[/TD]
[/TR]
</tbody>[/TABLE]

 

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