I have recently added a subroutine, CleanUpComments, to be called from multiple other subroutines to clean up comment positions and sizes. It works, but it is extremely slow taking about 10 seconds to run through ~200 comments. I have indicated the code section that accounts for the delay. (
wsPlan is the code name of the sheet I'm working with and all of the
UF_*** variables are global.) I have tried it with comments visible and hidden with no apparent difference.
Public Sub CleanUpComments() ' v8b1: Added to modify all comments to: ' (1) move and size with cells ' (2) be physically positioned near the cell to which they correspond ' (3) be optimally sized appropriate to the text within ' This was created by combining code posted on the following website: ' http://www.contextures.com/xlcomments03.html Dim CellComments As Comment Dim lngArea As Long Dim varReply As Variant '''vv This accounts for the 10 second delay ******************************************* For Each CellComments In wsPlan.Comments With CellComments.Shape .Placement = xlMoveAndSize .Top = CellComments.Parent.Top + 5 .Left = CellComments.Parent.Offset(0, 1).Left + 5 .TextFrame.Characters.Font.Name = "Tahoma" .TextFrame.Characters.Font.Size = 8 .TextFrame.AutoSize = True End With If CellComments.Shape.Width > 200 Then lngArea = CellComments.Shape.Width * CellComments.Shape.Height CellComments.Shape.Width = 150 CellComments.Shape.Height = (lngArea / 150) * 1.1 End If Next CellComments '''^^ This accounts for the 10 second delay ******************************************* UF_Caption = "SHOW COMMENTS" UF_Label1Caption = "Do you wish to leave comments showing?" UF_Height = 105 UF_TopOffset = 70 Call Updates_On UF_QuestionYN.Show varReply = UF_QuestionYN.Q_Reply Unload UF_QuestionYN Call Updates_Off If varReply Then Application.DisplayCommentIndicator = xlCommentAndIndicator Else Application.DisplayCommentIndicator = xlCommentIndicatorOnly End If End Sub
Is there a better (faster) approach to reset the comment positions and sizes?
(I tried this approach, checking if the values needed to be changed before I changed them, but it added another second!)
'''vv For Each CellComments In wsPlan.Comments With CellComments.Shape .Placement = xlMoveAndSize If .Top - CellComments.Parent.Top <> 5 _ Then .Top = CellComments.Parent.Top + 5 If .Left - CellComments.Parent.Offset(0, 1).Left <> 5 _ Then .Left = CellComments.Parent.Offset(0, 1).Left + 5 If .TextFrame.Characters.Font.Name <> "Tahoma" _ Then .TextFrame.Characters.Font.Name = "Tahoma" If .TextFrame.Characters.Font.Size <> 8 _ Then .TextFrame.Characters.Font.Size = 8 If .TextFrame.AutoSize <> True Then .TextFrame.AutoSize = True If .Width > 200 Then lngArea = .Width * .Height .Width = 150 .Height = (lngArea / 150) * 1.1 End If End With Next CellComments '''^^
I also have included my subroutine, Updates_Off, that I use to turn off updates and it is invoked in the calling routine so they are already off when CleanUpComments is called. (OBTW, the variables in this are all globals declared somewhere else.) I have also included my Updates_On to answer any questions about that.
Am I missing anything that I should be turning off that would speed this up?
Public Sub Updates_Off() ' Turn off Screen updating Application.ScreenUpdating = False ' Turn off Event tracking Application.EnableEvents = False ' Check what calculation mode is in effect and set current to manual CalcMode = Application.Calculation If CalcMode = xlCalculationManual Then _ MsgBox "Starting mode is manual" IterationMode = Application.Iteration Iterations = Application.MaxIterations Application.Calculation = xlCalculationManual End Sub Public Sub Updates_On() ' Turn on Screen updating Application.ScreenUpdating = True ' Turn on Event tracking Application.EnableEvents = True ' Reset Calculation mode Application.Calculation = CalcMode Application.Iteration = IterationMode Application.MaxIterations = Iterations If CalcMode = xlCalculationManual Then _ MsgBox "Reset to manual mode" End Sub