VBA to Vlookup cell text and return value as Cell Comment

Hello,

I am a beginner to VBA and I am trying to vlookup the cell values of column A in Datasheet from columns A:B in Mapping sheet. I want to return the value from Mapping sheet column B to Data sheet Column A in the form of a cell comment.

The other caveat is that Column A in data sheet contains duplicate values and I only want to return a comment in the first instance of the cell value. I’ve attached my working file. Your help would be greatly appreciated.

Thank you,
Alex

Edit: Attached corrected file

There is no matching data

But if you did have matching cells the code would look like this.

Sub Comment_It()
    Dim sh As Worksheet, ws As Worksheet
    Dim LstRw As Long, Rng As Range, c As Range, x As Variant
    Set sh = Sheets("Data")
    Set ws = Sheets("Mapping")

    With sh
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range("A2:A" & LstRw)
        For Each c In Rng.Cells
            With Application.WorksheetFunction
                t = .CountIf(ws.Range("A:A"), c.Value)
                If t > 0 Then
                    x = .VLookup(c, ws.Range("A:B"), 2, False)
                    With c
                        .ClearComments
                        .AddComment
                        .Comment.Visible = False
                        .Comment.Text x
                    End With
                End If
            End With
        Next c
    End With

End Sub

Sure thing, we'll just use collections and find....

Sub Comment_It()
    Dim sh As Worksheet, ws As Worksheet
    Dim cUnique As Collection
    Dim Rng As Range, c As Range, d As Range
    Dim Cell As Range
    Dim vNum As Variant
    Set sh = Sheets("Data")
    Set ws = Sheets("Mapping")


    Set Rng = sh.Range("A2", sh.Range("A2").End(xlDown))
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0

    For Each vNum In cUnique
        Set c = ws.Columns(1).Find(what:=vNum, lookat:=xlWhole)

        If Not c Is Nothing Then
            Set d = sh.Columns(1).Find(what:=vNum, lookat:=xlWhole)
            If Not d Is Nothing Then
                With d
                    .ClearComments
                    .AddComment
                    .Comment.Visible = False
                    .Comment.Text c.Text
                End With
            End If

        End If


    Next vNum

End Sub

I am not sure why you would think Vlookup() would be better than the find code? Don't use the 1st code, just use the 2nd code.

I don't know why you can't upload a new wb, possibly it is too large of a file or maybe you are trying to upload a file with the same name?

This works for me.

Sub tst()
    Set ws = Sheets("Data")
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Mapping")
        sn = .Cells(1).CurrentRegion.Value
    End With
    For i = 1 To UBound(sn)
        If Not dic.exists(sn(i, 1)) Then dic.Add sn(i, 1), sn(i, 2)
    Next
    For Each k In dic.keys
        fRow = Application.Match(k, ws.Columns(2), 0)
        If Not IsError(fRow) Then
            With ws.Cells(fRow, 2)
                .ClearComments
                .AddComment
                .Comment.Visible = False
                .Comment.Text dic.Item(k)
            End With
        End If
    Next
End Sub

Did you try the code in Post#10 ?

You're welcome and thanks for rep+.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.