View Single Post
 
Old 05-14-2021, 11:14 PM
Peterson Peterson is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 141
Peterson is on a distinguished road
Default Looping through comments is slow: inefficiently written code or par for the course?

I need to selectively change highlight colors applied to names in comments. The macro I cobbled together takes about 5-1/2 minutes to run through ~430 comments. Does the following code have glaring inefficiencies, or am I just being impatient?

(I created a second macro to create a test doc with an equivalent number of comments, and I thought I'd include it here to be helpful, but the highlight-change macro only seems to work on an actual document - the test docs don't work [the first comment is skipped, Word hangs.)

Code:
Sub FindReplace_COMMENTS_OneHighlightColorToAnother() ' 05/14/2021

' Finds highlighted text in comments and replaces
' the highlight with a different color

' This code omits user input elements, for brevity

    Dim strFindColor As String
    Dim strReplaceColor As String
    Dim myComment As Comment
    
    Application.ScreenUpdating = False
    
    ' (These variables are ordinarily set via input box
    ' 7 = yellow; 5 = pink; 4 = Bright Green; 3 = Turquoise (Bright Blue)):
    strFindColor = 5
    strReplaceColor = 4
                    
    For Each myComment In ActiveDocument.Comments
        
        DoEvents ' For large docs, Word crashes without DoEvents
        
        With myComment.Range.Find
            .ClearFormatting
            .Text = "Andy:"
            .Highlight = True
            .Forward = True
            Do While .Execute
                If .Found = True Then
                    With .Parent
                        If .HighlightColorIndex = Val(strFindColor) Then
                            .HighlightColorIndex = Val(strReplaceColor)
                            .Text = "Andy:"
                        End If
                    End With
                End If
            Loop
        End With
    Next

Application.ScreenUpdating = True
    
End Sub
Reply With Quote