Comments don't stay where they belong

[kajero52]

I have no idea how to write complicated macros so I try to find something on the Internet I can use. So far I haven't found much. Maybe some of you gurus could help me? Thanks for any assistance you can give me.

I have a spreadsheet that has 945 rows. It lists all the books since 2013 whether or not I have read them. Most of the rows have comments. When I try to view the comments sometimes they are way far away from the cell they are attached to. See example below.

I did find a macro o n YouTube that keeps the macro with the cell but then I can't read the comments easily
Sub ResetComments()
'Excel 10 Tutorial
Dim pComment As Comment
For Each pComment In Application.ActiveSheet.Comments
pComment.Shape.Top = pComment.Parent.Top + 5
pComment.Shape.Left = pComment.Parent.Offset(0, 1).Left + 5
Next
End Sub

This sometimes happens. Is there a way to make all the comments views the same size for easier reading. It really isn't necessary to have all the comment displayed at once but when the comment cross so many columns it is hard to read.

 

[Jaafar Tribak]

Is there a way to make all the comments views the same size for easier reading. It really isn't necessary to have all the comment displayed at once but when the comment cross so many columns it is hard to read.

You can reduce the width of the comments and increase their height manually or via code (similar to the code you have above)

 

[Peter_SSs]

Along the lines suggested by @Jaafar Tribak you could give this adaptation a try. It tries to auto-fit each comment, while setting a maximum value for the width of the comment box
Experiment with changing the 'Const' line value and see if you can find something that suits your needs.

Sub ResetComments_v2()
  Dim pComment As Comment
  Dim CmtArea As Long
 
  Const MaxWidth As Long = 300  '<- Try changing this number
 
  For Each pComment In Application.ActiveSheet.Comments
    With pComment.Shape
      .Top = pComment.Parent.Top + 5
      .Left = pComment.Parent.Offset(0, 1).Left + 5
      .TextFrame.AutoSize = True
      If .Width > MaxWidth Then
        CmtArea = .Width * .Height
        .Width = MaxWidth
        .Height = CmtArea / MaxWidth * 1.1
      End If
    End With
  Next pComment
End Sub