I have an Excel macro that does a find operation on a Word document and it is checking if the found text (range) is part of a content control. When it is part of a plain-text content control (like a drop-down list), I need to find the range of the entire content control (or the content control object itself) so I can apply a Word comment to it. This is because comments cannot be applied inside plain-text content controls. In all other cases, I just apply the comment to the result of the find operation.

The way I'm doing it now is expanding the range of the found text letter by letter until it is no longer within a content control. I end up with a range containing content control and I can apply a comment to it. The problem is that this is very slow and there must be a better way to find out which content control a range is within. Maybe looping through every content control object and testing if the found range is part of it is quicker?

This is what I have now which is pretty complicated and sloppy because it uses error handling to catch the cases where this scenario needs to be handled.

Sub CreateComment(ByRef wdDoc As Word.Document, ByVal sSearchValue As String)
    On Error GoTo 0
    Dim sComment As String
    Dim rngWd As Word.Range
    Dim rngWdCursor As Word.Range
    Dim rngWdCCtrl As Word.Range
    Set rngWd = wdDoc.Content
    With rngWd.Find
        .Text = sSearchValue
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
    End With


    While rngWd.Find.Found
        sComment = "This is the comment text"
        On Error GoTo TryContentControl
        wdDoc.Comments.Add Range:=rngWd, Text:=sComment
        Debug.Print Now & " Added Comment to: " & rngWd.Text
        GoTo Continue
        If Err.Number = 4605 Then 'error when the found text is part of a plain-text content control that does not allow comments.
            On Error GoTo 0
            'build up range for content control (this is super slow; should improve if possible)
            Set rngWdCCtrl = rngWd.Duplicate
            Set rngWdCursor = wdDoc.Range(Start:=rngWd.End, End:=rngWd.End)
            While rngWdCursor.Information(wdInContentControl)
                rngWdCCtrl.End = rngWdCCtrl.End + 1
                Set rngWdCursor = wdDoc.Range(Start:=rngWdCCtrl.End, End:=rngWdCCtrl.End)
            Set rngWdCursor = wdDoc.Range(Start:=rngWd.Start, End:=rngWd.Start)
            While rngWdCursor.Information(wdInContentControl)
                rngWdCCtrl.Start = rngWdCCtrl.Start - 1
                Set rngWdCursor = wdDoc.Range(Start:=rngWdCCtrl.Start - 1, End:=rngWdCCtrl.Start)
            'add comment on entire content control
            On Error Resume Next
            wdDoc.Comments.Add Range:=rngWdCCtrl, Text:="This is the comment text"
            On Error GoTo 0
            Debug.Print Now & " Added Comment to Content Control: " & rngWd.Text
        End If
        Resume Continue 'end error handling

        On Error GoTo 0

End Sub