Search code examples
excelvbacommentsvlookup

VBA Excel Comment Lookup


I have several data validation list in cells L6:U6. They are all the same list. The list comes from the range BD3:BD15 and is in alphabetical order. In cells BE3:BE15 I have comments regarding the different items that appear in my drop down list. What I am looking for is when an item is selected in any of my data validation cells, that the comment will be vlookup'ed from range BD3:BE15. So for example, you select the word "Burn" in the drop down or cell L6, and a vlookup will be done with range BD3:BE15 to pull the comment related to how to treat a burn will appear when you hover over cell L6.

Here is the code I have come up with, but when I run it I hit a few problems. I get a Run-time error '1004': Application-defined or object defined error. I hit okay and the comments only appear over cells L6:N6. For the comments I do get, I can not see the entire string, it gets cut off with several words off-screen. And when I select a different item, like the word "Poison", the comment does not update either. Can someone review the code I have and tell me where I am going wrong?

Sub CommentLookup()
'Range where you want to add comments to
Dim commentRange As Range
Dim c As Range
'Range to lookup
Dim lookRange As Range
'Define our ranges
Set commentRange = Range("$L$6:$U$6")
Set lookRange = Range("$BD$3:$BE$15")
Application.ScreenUpdating = True
'loop through and comment
For Each c In commentRange
    With c
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
        .Comment.Shape.TextFrame.AutoSize = False
    End With
Next c
Application.ScreenUpdating = True
End Sub

Solution

  • There's an issue with your VLOOKUP(). In the event that your cell does NOT have an entry in the VLOOKUP() table, it will error out. One quick solution is to slightly tweak the code:

    On Error Resume Next
    .Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
    On Error GoTo 0
    

    Another alternative would be to prompt the user to add the missing value/return value, but that's a little more involved and I'm not sure what you want to return if there's no VLOOKUP() entry found.

    Edit: Here's some error handling included. It will expand the VLOOKUP table if there's no entry for a cell value:

    Option Explicit
    
    Sub CommentLookup()
    Dim commentRange As Range 'Range where you want to add comments to
    Dim c As Range
    Dim lookRange As Range     'Range to lookup
    Set commentRange = Range("$L$6:$U$6")     'Define our ranges
    Set lookRange = Range("$BD$3:$BE$15")    
    Application.ScreenUpdating = False
    For Each c In commentRange 'loop through and comment
        With c
            c.Select
            .ClearComments
            .AddComment
            .Comment.Visible = False
            On Error GoTo tableAdd
            .Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
            On Error GoTo 0
            .Comment.Shape.TextFrame.AutoSize = False
        End With
    Next c
    Application.ScreenUpdating = True
    Exit Sub
    
    tableAdd:
    Dim entry As String
    entry = InputBox("What is the expected return value for " & c.Value)
    With lookRange
        .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Value = entry
        .Cells(.Rows.Count, 1).Offset(1, 0).Value = c
        Set lookRange = Range("$BD$3:$BE$" & .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Row)
    End With
    Resume Next
    
    End Sub