Search code examples
arraysvbacollectionsms-wordmsgbox

VBA collections - List found items in MsgBox


I was wondering about making a word searcher in a Word document. Previously, all I managed to create is a code that makes it possible to highlight the words I added to a list:

Sub example

Dim w(3) as String
Dim k, l as Integer

w(1)= "word1"
w(2)= "word2"
w(3)= "word3"


Set r = Selection
r.HomeKey Unit:=wdStory

    For k = 1 To 3
        With r.Find
            .ClearFormatting
            .Text = w(k)
            For l = 1 To 10
                .Execute Wrap:=wdFindStop, Forward:=True
                     If .Found = False Then
                       Exit For
                     End If
                r.Range.HighlightColorIndex = wdRed
                r.Collapse Direction:=wdCollapseEnd
            Next
        End With
      r.HomeKey Unit:=wdStory
    Next
End Sub

And it worked perfectly. But my aim was to display all the found words in MsgBox. So I've updated the code:

Sub example

Dim w(3) as String
Dim k, l as Integer

w(1)= "word1"
w(2)= "word2"
w(3)= "word3"

Dim wcoll As Collection
Set wcoll = New Collection


Set r = Selection
r.HomeKey Unit:=wdStory

    For k = 1 To 3
        With r.Find
            .ClearFormatting
            .Text = w(k)
            For l = 1 To 10
                .Execute Wrap:=wdFindStop, Forward:=True
                     If .Found = False Then
                       Exit For
                     End If
                r.Range.HighlightColorIndex = wdRed
                r.Collapse Direction:=wdCollapseEnd

                wcoll.Add (w(k))

            Next
        End With
      r.HomeKey Unit:=wdStory
    Next

MsgBox("Found words: " & wcoll(1) & " " & wcoll(2) & " " & wcoll(3)) 

End Sub

The problem - that I have realized just at the end - is, when the doc contains only 2 of the words searched, but I try to display using the index value 3 as the subscript wcoll(3) the MsgBox won't pop up. Instead I get a subscript out of range error. How should I solve this issue, to display all the words (even if there are just the same words)?


Solution

  • You could do it as follows. My addition checks whether the collection wcoll contains any members. If it does, the text to show in the MsgBox is concatenated. First the static text is assigned, then the members of the collection are looped and the values appended to the string. If there are no members, a default text is assigned.

    Sub example()    
      Dim w(3) As String, foundWords As String
      Dim k, l As Integer
      Dim wcoll As Collection
      Dim r as Selection
    
    w(1) = "word1"
    w(2) = "word2"
    w(3) = "word3"
    
    Set wcoll = New Collection        
    Set r = Selection
    r.HomeKey Unit:=wdStory
    
        For k = 1 To 3
            With r.Find
                .ClearFormatting
                .Text = w(k)
                For l = 1 To 10
                    .Execute wrap:=wdFindStop, Forward:=True
                         If .found = False Then
                           Exit For
                         End If
                    r.Range.HighlightColorIndex = wdRed
                    r.Collapse Direction:=wdCollapseEnd
    
                    wcoll.Add (w(k))    
                Next
            End With
          r.HomeKey Unit:=wdStory
        Next
    
        If wcoll.Count > 0 Then
            foundWords = "Found words: "
            For k = 1 To wcoll.Count
                foundWords = foundWords & " " & wcoll(k)
            Next
        Else
            foundWords = "No words were found."
        End If
        MsgBox foundWords    
    End Sub