Auto comment Box

[LanceLance]

Hi all,
Looking for some help on Comment boxes

I would like to auto position all comment boxes to setlocation closest to cell.

e.g.
All comments to be placed N1:NN9 (Top of sheet)
So if a comment was entered in cell BH33 or BH 11, itwould automatically get re positioned between to BH1:BH9.


I have been using:
Sub ResetComments()
Dim pComment As Comment
For Each pComment InApplication.ActiveSheet.Comments
pComment.Shape.Top = pComment.Parent.Top + 100
pComment.Shape.Left = pComment.Parent.Offset(0, 1).Left + 100
Next
End Sub

But his only moves comment boxed by offset of 100 and notto desired location, and no good with the amount of rows I have in sheet.

Second part of my issue is to ensure comments do not overlap.
I am using following to:
SubComments_AutoSize()
Dim MyComments AsComment
Dim lArea As Long
For EachMyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
' An adjustment factor of 1.1 seems towork ok.
.Shape.Height = (lArea / 200) * 1.1
End If
End With
Next ' comment
End Sub

To resize but, unable to ensure no comment overlap.

Any Help appreciated.

Regards

Lance

 

[LanceLance]

Code updated to:


Sub Comments_AutoSize()
Dim pComments As Comment
Dim lArea As Long
For Each pCommentsIn ActiveSheet.Comments
With pComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width> 300 Then
lArea =.Shape.Width * .Shape.Height
.Shape.Width =200
.Shape.Height =(lArea / 200) * 1.2
End If
End With
Next
For Each pComment In Application.ActiveSheet.Comments
pComment.Shape.Top= pComment.Parent.Top - 10000
pComment.Shape.Left= pComment.Parent.Offset(0, 1).Left + 1
Next
End Sub


Although still unable to manage multiple comment box overlap??