How to use each value in column 1 to add comment (NOTE) from 2 different columns?

user_13121714 0
Viewed 59

I need a dynamic way to add Note in which cell in my ID column A. However the comments need to use the information from Column B and C. ex: ON 01/13/2020, Anne. I am not sure how to check how many times each value from column A will appear and use information from column D and B to create the comment (NOTE)..

Table

result I need. All the time the ID number will be the same the comments need to be the same as well.

Result I need

The code I am using is

Sub Cmt_test()

Sheet1.Range("A2").AddComment "On " & Sheet1.Range("D2") & ", " & Sheet1.Range("B2")

End Sub

I don't know how I can make it dynamic to get the information all the time the same ID appears. Maybe if I use Loop on column A would it be possible that all the time the loop finds the same ID to add the comment using the information from column D and B?

vba excel
1 Answers

Write Comments to Each Cell in a Column

Option Explicit

Sub addComments()
    
    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 2
    Const LastRowCol As Long = 1 ' or "A"
    Const str1 As String = "On "
    Const str2 As String = ", "
    Dim Cols As Variant: Cols = Array(1, 2, 4)
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim LastRow: LastRow = ws.Cells(ws.Rows.Count, LastRowCol).End(xlUp).Row
    Dim Vals As Variant: ReDim Vals(UBound(Cols))
    
    ' Define Source Range.
    Dim rng As Range: Set rng = ws.Range(ws.Cells(FirstRow, Cols(0)), _
                           ws.Cells(LastRow, Cols(0)))
    
    ' Write Column Ranges to Arrays.
    Dim j As Long
    For j = 0 To UBound(Cols)
        Vals(j) = rng.Offset(, Cols(j) - Cols(0))
    Next j
    
    ' Loop through elements (rows) of Source Array
    ' and write comments to a dictionary.
    Dim dict As Object, Curr As Variant, i As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Vals(0))
         Curr = Vals(0)(i, 1)
         If dict(Curr) <> "" Then
             dict(Curr) = dict(Curr) & vbLf & str1 _
               & Format(Vals(2)(i, 1), "mm/dd/yyyy") & str2 & Vals(1)(i, 1)
         Else
             dict(Curr) = str1 _
               & Format(Vals(2)(i, 1), "mm/dd/yyyy") & str2 & Vals(1)(i, 1)
         End If
    Next i
     
    ' Write comments from the dictionary to Source Range.
    rng.ClearComments
    Dim cel As Range
    For Each cel In rng.Cells
        cel.AddComment dict(cel.Value)
    Next cel

End Sub
user_98140690
Related