• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to add results of a VLOOKUP to cell comments

JCTalk

Member
Hiya,

I am considering the possibility of using some VBA to lookup a range values from a different worksheet and use the returned result as the comment in the same range of lookup cells.

This would need to update on worksheet change.

I've attached an example of what I would imagine the spreadsheet would look like. It should lookup the values in 'MainTable'$A$2:$A$6 on 'Data'$A$2:$A$6. If it finds the value, it should return a concatenation of the relevant "Field2 - Field 3 - Field 4" in the original lookup table. Replace any comments that are currently in there.

Is that possible?

Many thanks
 

Attachments

  • VBA Comment from Lookup.xlsx
    8.9 KB · Views: 63
Code:
Sub blah()
Dim IDonDataSheet As Range
lr = Sheets("mainTable").Cells(Rows.Count, "A").End(xlUp).Row
For Each cll In Sheets("mainTable").Range("A2:A" & lr).Cells
  With cll
    Set IDonDataSheet = Sheets("Data").Columns(1).Find(.Value, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
    If Not IDonDataSheet Is Nothing Then
      mycomment = Join(Application.Index(IDonDataSheet.Offset(, 1).Resize(, 3).Value, 1, 0), " - ")
      Set xxx = .Comment
      If .Comment Is Nothing Then .AddComment
      .Comment.Text Text:=mycomment  'this overwrites existing comment
    Else
      'here, what you want to do when the ID is not found on the data sheet; perhaps delete any existing comment or pop a note into it that it's not found?
    End If
  End With
Next cll
End Sub
 
Hi P45cal,

That's brilliant! :D Thank you.

Rather than return a range of cells from columns next to each other, how would I specify certain columns to return. At the moment it is returning the relevant cell from column B, C & D (assume from the Offset and the resize part), but lets say I wanted columns B, D and F for example. How would I accomplish this?

Also, I tried to hook this up to Worksheet Change, but it didn't seem to do anything. It would only add the comments if I directly called the macro? I'd like to try and get it to update everytime the worksheet changes if possible.

Many thanks P45cal.
 
Hi p45cal,

Excellent. That will let me adapt the code for other cell lookups.

Reference which worksheet regarding the updating. It would be updates on the mainTable sheet. Potentially I could be adding more ID's you see that need the comments adding. If the code ran every time the worksheet changed, then the new additions would get the updates I'd guess?

Do you think that would be too intensive for the sheet? I guess it depends on the amount of ID's that are in the Data sheet that it looks up from?

Many thanks
 
in the maintable sheet's code-module:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToProcess As Range, IDonDataSheet As Range

Set RngToProcess = Intersect(Target, Range("A2:A1000")) 'adjust this range to suit.
If Not RngToProcess Is Nothing Then
  For Each cll In RngToProcess
    With cll
      Set IDonDataSheet = Sheets("Data").Columns(1).Find(.Value, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
      If Not IDonDataSheet Is Nothing Then
        mycomment = Join(Array(IDonDataSheet.Offset(, 1), IDonDataSheet.Offset(, 3), IDonDataSheet.Offset(, 5)), " - ")  'B,D & F
        'mycomment = Join(Application.Index(IDonDataSheet.Offset(, 1).Resize(, 3).Value, 1, 0), " - ")
        If .Comment Is Nothing Then .AddComment
        .Comment.Text Text:=mycomment  'this overwrites existing comment
      Else
        'here, what you want to do when the ID is not found on the data sheet; perhaps delete any existing comment or pop a note into it that it's not found?
      End If
    End With
  Next cll
End If
End Sub
What it doesn't do is blank out/delete a comment if the ID is not recognised.
 
Code:
Sub blah()
Dim IDonDataSheet As Range
lr = Sheets("mainTable").Cells(Rows.Count, "A").End(xlUp).Row
For Each cll In Sheets("mainTable").Range("A2:A" & lr).Cells
  With cll
    Set IDonDataSheet = Sheets("Data").Columns(1).Find(.Value, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
    If Not IDonDataSheet Is Nothing Then
      mycomment = Join(Application.Index(IDonDataSheet.Offset(, 1).Resize(, 3).Value, 1, 0), " - ")
      Set xxx = .Comment
      If .Comment Is Nothing Then .AddComment
      .Comment.Text Text:=mycomment  'this overwrites existing comment
    Else
      'here, what you want to do when the ID is not found on the data sheet; perhaps delete any existing comment or pop a note into it that it's not found?
    End If
  End With
Next cll
End Sub
thanks so much it so good. If we are having unique values in the column and comment is taking first occurrence. If it is possible to overcome this, it will so much helpful for all.
 
Hi, I'm using this from p45cal, it works but is restricted to only 255 characters from the cells and goes to error if exceeded. Read something about comments now being a range, and this solves the 255 character problem. I tried to modify it but could not get it working correctly.

Many thanks

Code:
Sub blah()
Dim IDonDataSheet As Range
lr = Sheets("mainTable").Cells(Rows.Count, "A").End(xlUp).Row
For Each cll In Sheets("mainTable").Range("A2:A" & lr).Cells
  With cll
    Set IDonDataSheet = Sheets("Data").Columns(1).Find(.Value, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
    If Not IDonDataSheet Is Nothing Then
      mycomment = Join(Application.Index(IDonDataSheet.Offset(, 1).Resize(, 3).Value, 1, 0), " - ")
      Set xxx = .Comment
      If .Comment Is Nothing Then .AddComment
      .Comment.Text Text:=mycomment  'this overwrites existing comment
    Else
      'here, what you want to do when the ID is not found on the data sheet; perhaps delete any existing comment or pop a note into it that it's not found?
    End If
  End With
Next cll
End Sub
 
Back
Top