How to resize comments on selected range instead of whole sheet?

Question

The following code auto resizes comments (notes) in my Excel spreadsheet.

The code is slow. To speed it up I wish to specify a smaller range not the whole sheet. Let's say cells A1 to B10.

Sub NotesResize()

Dim MyComments As Comment
Dim lArea As Long

For Each MyComments 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 to work ok.
            .Shape.Height = (lArea / 200) * 1.1
        End If
    End With
Next ' comment
End Sub

I tried setting ranges as follows.

I get

Run time error '438': Object doesn't support this property or method.

Sub NotesResizeSelection()

Dim MyComments As Comment
Dim lArea As Long
Dim rng2 As Range
Set rng2 = Range("A1:B10")

For Each MyComments In rng2.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 to work ok.
            .Shape.Height = (lArea / 200) * 1.1
        End If
    End With
Next ' comment
End Sub

Not tested but shapes have a `topleftcell` property which you might be able to utilise. — SJR, Nov 02 '22 at 10:23

mtholen · Accepted Answer · 2022-11-03T09:40:14.957

the range object does not have a collection of comments so your call to rng2.Comments is invalid, hence the error. Comments is a property of the Worksheet object.

What you could do is verify if the active comment is in the selected range? Though this would still loop through all the comments?

Like below:

Sub NotesResizeSelection()

Dim MyComments As Comment
Dim lArea As Long
Dim rng2 As Range
Set rng2 = Range("A1:B10")

minRow = rng2.row
maxRow = minRow + rng2.Rows.Count - 1
minColumn = rng2.Column
maxColumn = minColumn + rng2.columns.Count - 1

For Each Comment In ActiveSheet.Comments
    cRow = Comment.Parent.row
    cCol = Comment.Parent.Column
    If (cRow >= minRow And cRow <= maxRow) And (cCol >= minColumn And cCol <= maxColumn) Then
        With Comment
          .Shape.TextFrame.AutoSize = True
          If .Shape.Width > 300 Then
            lArea = .Shape.Width * .Shape.Height
            .Shape.Width = 200
            ' An adjustment factor of 1.1 seems to work ok.
            .Shape.Height = (lArea / 200) * 1.1
          End If
        End With
    End If
Next ' comment
End Sub

Alternatively you could loop through all the Cells of the range and determine if cell.Comment Is Not Nothing and then set the relevant comment if it is not nothing.

Though arguably if this would be faster than working on each comment?

You could contemplate trying to set Application.Screenupdating = false but that can be tricky. (see also my answer here: Screen Updating)

This solution worked superbly. Thankyou @mtholen my original code's time overhead was 25 secs as it worked over a very large sheet. With your solution I was able to select 5 columns of interest, reducing the time overhead to 1 sec!!! Superb result. — rockingmark, Nov 03 '22 at 15:08

How to resize comments on selected range instead of whole sheet?

1 Answers1