Convert column into notes and apply to other columns

Copper Contributor

Hello, 

 

I have a curiosity. Can I convert some column into notes and apply those notes to other column?

For example, how do I convert the last three column into notes and apply them to the Injury Location (Just a sample, not related to the actual information in the excel).

Daniela33_1-1637919561886.png

 

Thank you!

 

8 Replies

@Daniela33 

You could run a macro like this:

Sub CreateComments()
    Dim r As Long
    Dim m As Long
    m = Range("L:N").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To m
        Range("B" & r).AddComment Text:=Range("L" & r).Value & " " & _
            Range("M" & r).Value & " " & Range("N" & r).Value
    Next r
End Sub

@Hans Vogelaar  Hans I looked absolutely everywhere for this. Thank you so very much for Charing your knowledge.  This VBA formula also create notes for blank cells, how can I avoid or ignore blank cells and only make notes where there are "*"

 

If you can also share a VBA formula to use xlookup and then copy and paste exciting notes in a range 

@LizeMarie 

Like this:

Sub CreateComments()
    Dim r As Long
    Dim m As Long
    m = Range("L:N").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To m
        If Range("B" & r).Value <> "" Then
            Range("B" & r).AddComment Text:=Range("L" & r).Value & " " & _
                Range("M" & r).Value & " " & Range("N" & r).Value
        End If
    Next r
End Sub

@LizeMarie 

Can you explain your second question (about XLOOKUP) in more detail?

OMW Hans you are absolutely awesome, made my day. Thank you.
If Column I & J & K matches Column B & C & D then it must copy only the notes in Range("L:O") to Range ("E:H"). so it must loop trough each row finding a match and past the correct notes to that matching row. So if Range("I1:K1) match Range("B10:D10") it must past only the notes of Range("L1:O1") to Range("E10:H10") ... and loops through all doing the same. hope it makes sense
I amended it a bit with my ranges, and it works 100% thank you - I really appreciate your help. I struggled with this for weeks now.
Sub CreateComments()
Dim r As Long
Dim m As Long
m = Range("Q:R").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = 2 To m
If Range("Q" & r) = "" Then
Range("L" & r) = ""
Else
Range("L" & r).AddComment Text:=Range("Q" & r).Value & " " & _
Range("M" & r).Value & " " & Range("R" & r).Value

End If
Next r
End Sub

@LizeMarie 

Does this work?

Sub CopyComments()
    Dim r As Long
    Dim m As Long
    Dim v As Variant
    Dim c As Long
    Application.ScreenUpdating = False
    m = Range("B" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        v = Evaluate("MATCH(1,(I:I=B" & r & ")*(J:J=C" & r & ")*(K:K=D" & r & "),0)")
        If IsNumeric(v) Then
            For c = 1 To 4
                If Not Cells(v, c + 11).Comment Is Nothing Then
                    Cells(r, c + 4).AddComment Text:=Cells(v, c + 11).Comment.Text
                End If
            Next c
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
Hans you have absolutely no idea how much I appreciate this. you are so helpful and kind to do so. This is what I'm looking for, for so long and I just couldn't get my VBA code to work. Amazing. Thank you again. Just show me that there is still much to learn about VBA coding.