Macro applying modification to comment on selected cells

[brucewflee]

Hi,

I have been using the following macro to edit the font and size of my comment box.

Sub FixComments()


        Dim MyComments As Comment
        For Each MyComments In ActiveSheet.Comments
            
            With MyComments
            .Shape.TextFrame.AutoSize = True
            If .Shape.Width > 300 Then
                Dim lArea As Long
                lArea = .Shape.Width * .Shape.Height
                .Shape.Width = 250
                .Shape.Height = (lArea / 200) * 1.1
            End If
            End With
            With MyComments.Shape.TextFrame.Characters.Font
                .Name = "Tahoma"
                .Size = 10
                .Bold = False
            End With
        Next MyComments


    End Sub

However, with my sheet getting larger and larger, the time it is being used when I run this macro is getting longer. Is there a way I can select the cells I want to apply the macro instead to speed up the process?

I have tried using "For each cell in Selection.Cells" but it is still running the whole sheet unfortunately.

 

[gallen]

What rules dictate which cells? Is it to be a manual selection?

 

[gallen]

I just tested on a sheet with > 200 comments and it took 46 seconds to run your macro! Not sure why I can only assume that comments are resource heavy..

 

[gallen]

You need to disable screen updating to get a decent time saving. Try this:

Sub FixComments()


Dim d As Date
Dim r As Range


        d = Now
        Application.ScreenUpdating = False
        On Error Resume Next
        For Each r In Selection
            If Not r.Comment Is Nothing Then
                With r.Comment
                .Shape.TextFrame.AutoSize = True
                    If .Shape.Width > 300 Then
                        Dim lArea As Long
                        lArea = .Shape.Width * .Shape.Height
                        .Shape.Width = 250
                        .Shape.Height = (lArea / 200) * 1.1
                    End If
                End With
                With r.Comment.Shape.TextFrame.Characters.Font
                    .Name = "Tahoma"
                    .Size = 10
                    .Bold = False
                End With
            End If
            'DoEvents
        Next r
        Application.ScreenUpdating = True


    MsgBox "Time taken = " & DateDiff("s", d, Now) & " seconds", vbInformation, "Processed " & Selection.Cells.Count & " cells"
    
    End Sub

 

[brucewflee]

Thanks Gallen. It works perfect.

My original macro does have the screen updating disabled. I have only posted the main bit here just to avoid confusion.

So it is the bit "For Each r In Selection" which makes it work right. How it is different from Selection.Cells just wondering?

 

[gallen]

r is dimmed as a range. As far as I'm aware, there should be no difference. I've just tested it and getting the same time to loop through over 200 comments with Selection and Selection.Cells so I'm a little confused if it slows yours down.