Dynamically change comments, after change to another cell

[dslhs]

Hello,

I'm looking for a macro that will dynamically change the comments attached to a range of cells (entering the results from the formula in the cell), triggered by the change in value of another cell.

Specifically...

I'm looking for a macro that will be triggered by any changes to the contents of A2

Once triggered it will update all the comments attached to cells F7:F100, M7:M100, Z7:Z100, AA7:AA100, AB7:AB100, AC7:AC100 so that they include the results from the formula's in their respective cells.

(So once I change A2, the comments in F7 will reflect the results from the formula in F7, and the comments in F8 will reflect the results from the formula in F8, etc...).

I tried this, but I'm really bad at VBA so it didn't work:

Sub ValueToComment()
    Dim rCell As Range
    If Union(Target, Range("A2")).Address = Target.Address Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        sResult = Target.Value
        Target.ClearContents
    For Each rCell In Selection F7:F100, M7:M100, Z7:Z100, AA7:AA100, AB7:AB100, AC7:AC100
        With rCell
            If .HasFormula Then
                On Error Resume Next
                .Comment.Delete
                On Error GoTo 0
                .AddComment
                .Comment.Text Text:=CStr(rCell.Value)
            End If
        End With
    Next
    Set rCell = Nothing
End Sub

Any ideas?

Many thanks,

 

[dslhs]

Thanks. I've managed to find a solution that works for me and my purposes:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rCell As Range
  If Target.Address = Range("A2").Address Then
    For Each rCell In Range("F7:F100,M7:M100,N7:N100,Q7:Q100,AA7:AA100,AB7:AB100,AC7:AC100,AD7:AD100,AE7:AE100").SpecialCells(xlCellTypeFormulas, 23)
      With rCell
        On Error Resume Next
        .Comment.Delete
        On Error GoTo 0
        If .Value <> "" Then
          .AddComment
          .Comment.Text Text:=CStr(rCell.Value)
          .Comment.Shape.TextFrame.AutoSize = True
          .Comment.Shape.Width = .Comment.Shape.Width * 0.5
          .Comment.Shape.Height = .Comment.Shape.Height * 3
          .Comment.Shape.TextFrame.HorizontalAlignment = xlHAlignLeft
        End If
      End With
    Next rCell
  End If
End Sub

By AutoSizing, and then reducing the width, and increasing the height, it fits better to the screen. I could do * 0.5 for width and * 2 for height for a snug fit, but I like there to be space.

HaHoBe, thank you so much for your help. Just so you know, this will be used for the special needs school I work in. It'll make a big difference in communicating key information about students to staff. Really appreciate it!

 

[HaHoBe]

Hi dslhs,

glad you found a way to get the result you expected. Thanks for the feedback.

Holger

 

[dslhs]

Hi HaHoBe,

I'm back! My fix half works, but I'm trying to improve it and can't get it right.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rCell As Range
  If Target.Address = Range("A2").Address Then
    For Each rCell In Range("F7:F100,M7:M100,N7:N100,Q7:Q100,AA7:AA100,AB7:AB100,AC7:AC100,AD7:AD100,AE7:AE100").SpecialCells(xlCellTypeFormulas, 23)
      With rCell
        On Error Resume Next
        .Comment.Delete
        On Error GoTo 0
        If .Value <> "" Then
          .AddComment
          .Comment.Text Text:=CStr(rCell.Value)
          .Comment.Shape.TextFrame.AutoSize = True
          .Comment.Shape.Width = .Comment.Shape.Width * 0.5
          .Comment.Shape.Height = .Comment.Shape.Height * 3
          .Comment.Shape.TextFrame.HorizontalAlignment = xlHAlignLeft
        End If
      End With
    Next rCell
  End If
End Sub

I'm looking to have different .Comment.Shape.Width and .Comment.Shape.Height for different ranges:

So F7:F100,M7:M100,N7:N100,Q7:Q100 would be W*0.5 H*3
and AA7:AA100,AB7:AB100,AC7:AC100,AD7:AD100,AE7:AE100 would be W*0.1 H*10

But I can't get it to work. I tried doing another If, or intergrate it into the if that's already there, but it didn't work.

Any ideas?

 

[HaHoBe]

Hi dslhs,

the easiest way would be to split the range into two and work on each range on each own like

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rCell As Range
  If Target.Address = Range("A2").Address Then
    For Each rCell In Range("F7:F100,M7:M100,N7:N100,Q7:Q100").SpecialCells(xlCellTypeFormulas, 23)
      With rCell
        On Error Resume Next
        .Comment.Delete
        On Error GoTo 0
        If .Value <> "" Then
          .AddComment
          .Comment.Text Text:=CStr(rCell.Value)
          .Comment.Shape.TextFrame.AutoSize = True
          .Comment.Shape.Width = .Comment.Shape.Width * 0.5
          .Comment.Shape.Height = .Comment.Shape.Height * 3
          .Comment.Shape.TextFrame.HorizontalAlignment = xlHAlignLeft
        End If
      End With
    Next rCell
    For Each rCell In Range("AA7:AA100,AB7:AB100,AC7:AC100,AD7:AD100,AE7:AE100").SpecialCells(xlCellTypeFormulas, 23)
      With rCell
        On Error Resume Next
        .Comment.Delete
        On Error GoTo 0
        If .Value <> "" Then
          .AddComment
          .Comment.Text Text:=CStr(rCell.Value)
          .Comment.Shape.TextFrame.AutoSize = True
          .Comment.Shape.Width = .Comment.Shape.Width * 0.1
          .Comment.Shape.Height = .Comment.Shape.Height * 10
          .Comment.Shape.TextFrame.HorizontalAlignment = xlHAlignLeft
        End If
      End With
    Next rCell
  End If
End Sub

Although I must state that the width of 0,1 will not display any information on my system.

Ciao,
Holger