[Excel 2010] Performance issues scanning external documents for text


New Member
Sep 4, 2014
Hey guys,
i need ur help in order to solve a problem with my code.
The goal is, starting from a compiled table in excel, to scan a single column and find, for each cell value, a match in the documents contained in a specific folder.
The code i wrote works but i have encountered many problems with the performance of the execution.
Briefly the code:

  • Read the entire 3rd column and populate a collection
  • When the excel reading is done it pass to the file management opening each one and searching it for each keyword previously stored in the collection
  • When done with files search the control pass again to the excel in order to update an adiacent column with the search results

Now about the numbers: i have to search around 8-10 thousand values in about 800-1.000 word files.
The execution time, in seconds, is around values * documents / 12, for the specific case we're talking of 4 days of runtime, lol
Any suggestion about what to use (structures, search methods, etc..) to improve timewise?

Here the code:

Function test()

    Dim elencoPartizioni As New Collection
    Dim tempPartizione As CPartizione
    Dim oWordDoc, oWordApp, rngStory As Object
    Dim searchPattern, fileExtensionPattern, sourceFolder, filePath, sFileName, searchResults As String
    Dim idRow As Long
    Dim startTime, endTime As Date
    sourceFolder = "C:\Users\itals007\Desktop\note\"
    fileExtensionPattern = "*.doc?"
    filePath = Dir$(sourceFolder & fileExtensionPattern)
    Set oWordApp = CreateObject("Word.Application")
    oWordApp.Visible = False
    startTime = Now
    idRow = 8
    While Cells(idRow, 3).value <> ""
        Set tempPartizione = New CPartizione
        tempPartizione.nomePartizione = LCase(Cells(idRow, 3).value)
        On Error Resume Next
        elencoPartizioni.Add tempPartizione, tempPartizione.nomePartizione
        idRow = idRow + 1
    While filePath <> ""
        On Error GoTo errorHandling
        sFileName = sourceFolder & filePath
        Set oWordDoc = oWordApp.Documents.Open(sFileName)
        Dim iPartizione As CPartizione
        For Each iPartizione In elencoPartizioni
            If LCase(Left(oWordDoc.Name, InStrRev(oWordDoc.Name, ".") - 1)) = LCase(iPartizione.nomePartizione) Then
                iPartizione.presenzaNotaOperativa = "Presenti"
                iPartizione.elencoMatchNoteOperative.Add oWordDoc.Name
            End If
            For Each rngStory In oWordDoc.StoryRanges

                With rngStory.Find
                    .Text = iPartizione.nomePartizione
                    .Wrap = 1
                    If .found And iPartizione.presenzaNotaOperativa <> "Presenti" Then
                        iPartizione.elencoMatchNoteOperative.Add oWordDoc.Name
                        iPartizione.presenzaNotaOperativa = "Parziali"
                        Exit For
                    End If
                End With
        filePath = Dir$()
        If Err.Number <> 0 Then
            MsgBox "Errore", vbCritical
        End If

    Set oWordDoc = Nothing
    Set oWordApp = Nothing
    idRow = 8
    While Cells(idRow, 3).value <> ""
        Cells(idRow, 2).ClearComments
        If elencoPartizioni.Item(LCase(Cells(idRow, 3).value)).presenzaNotaOperativa = "" Then
            Cells(idRow, 2).value = "Non presenti"
            Cells(idRow, 2).value = elencoPartizioni.Item(LCase(Cells(idRow, 3).value)).presenzaNotaOperativa
            Cells(idRow, 2).AddComment elencoPartizioni.Item(LCase(Cells(idRow, 3).value)).elencoMatchNote
            Cells(idRow, 2).Comment.Shape.TextFrame.AutoSize = True
        End If
        idRow = idRow + 1
    endTime = Now
    MsgBox "Esecuzione in " & DateDiff("s", startTime, endTime) & " s"
End Function

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back