excel - Adding a note to a cell based on another cell

Question

I am trying to add a specific note to a cell based on the cell value to explain what the cell contents are. I am trying to use the code below to do this but I get a run-time error '1004' on the following line:

Target.Cells.Comment.Text Text:=Comment_E

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Defining what column is being changed
    
    If Target.Column = 3 Then
    
        'Adding a comment to the cell
        Dim Status_Col As String
        Dim NA As String
        Dim i As Integer
        'Types
        Dim Comment_T As String
        'Explainations
        Dim Comment_E As String
    
        i = 4
        Comment_T = Target.Cells.Value
        For i = 4 To 10    ' checking the list of types
            If Cells(i, 14).Value = Comment_T Then
                Comment_E = Cells(i, 15).Value
            End If
        Next i
        
        Target.Cells.Select
        Target.Cells.AddComment
        Target.Cells.Comment.Visible = False
        Target.Cells.Comment.Text Text:=Comment_E
        Selection.ShapeRange.ScaleHeight 0.48, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleWidth 3.32, msoFalse, msoScaleFromTopLeft
    
    End If
End Sub

标签： excelvba

Answer 1

You need to account for the case where a cell already has a comment, and the case where multiple cells are updated (eg fill down).

Few fixes/suggestions:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v, cmt As Comment, rng As Range, c As Range
    
    'any changes in Col3?
    Set rng = Application.Intersect(Target, Me.Columns(3))
    'optionally set some limit for the size of change you want to handle
    If rng.Cells.CountLarge > 100 Then Exit Sub
    'now process each cell in the col3 range
    For Each c In rng.Cells
    
        v = Application.VLookup(c.Value, Me.Range("N4:O10"), 2, False)
        
        If Not IsError(v) Then
            Set cmt = c.Comment 'already has a comment?
            If cmt Is Nothing Then
                Set cmt = c.AddComment() 'no comment so add one
                With cmt                 'formatting...
                    .Visible = False
                    .Shape.Height = 30   'fixed height/width is easier
                    .Shape.Width = 100
                End With
            End If
            cmt.Text v 'set/replace text
        End If
    Next c
End Sub