Ways to improve the performance of my Word macro that hides hard coded text

[jdvelasquez]

Hello,

I recycled an old macro in a TechRepublic post that helps users highlight text in a document if it is present in a collection of strings.

In my case, I need it to hide the text instead of highlighting it, so I changed it as follows:

Attribute VB_Name = "NewMacros"
Sub SpanishTextHiderBVS()
'
' SpanishTextHiderBVS Macro
'
'
Application.ScreenUpdating = False

Dim Word As Range

Dim WordCollection(2) As String

Dim Words As Variant

'Define list.

'If you add or delete, change value above in Dim statement.

WordCollection(0) = "EVALUACIÓN INTRODUCCIÓN"
WordCollection(1) = "EVALUACIONES SOBRE EL DESEMPEÑO ACADÉMICO"
WordCollection(2) = "administrada por"

'Cycle through document and find words in collection.

For Each Word In ActiveDocument.Words

For Each Words In WordCollection

With Selection.Find

.Text = Words: .Replacement.Text = "": .Replacement.Font.Hidden = True: .Forward = True: .Wrap = wdFindContinue: .Format = True: .MatchCase = True

End With

Selection.Find.Execute Replace:=wdReplaceAll

Next
Next
End Sub

My challenge is that the macro is sluggish in long documents (it can take 8-9 minutes to loop through a 19-page document).

I read (see source) that the trick is to use ranges instead of selections (my case), but I struggle to code it correctly.

Do you have any hints or tips?

[#2 · Accepted solution]

@jdvelasquez Use the following code

Dim arrWords As Variant
arrWords = Split("EVALUACIÓN INTRODUCCIÓN|EVALUACIONES SOBRE EL DESEMPEÑO ACADÉMICO|administrada por", "|")
For i = LBound(arrWords) To UBound(arrWords)
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = arrWords(i)
        .Replacement.Font.Hidden = True
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .MatchCase = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Next i

[#3]

Hi Doug,

Happy Friday!

Indeed, this did the trick since it will not execute the whole process per string.

My next step will be to use a document list instead of putting all the text to hide inside the macro.

Thank you so much for passing by and helping me.

Kind regards,
Joshua

[#4]

@jdvelasquez The following code will act on a list of words in Column A of the Excel workbook for which the path\filename is included where indicated in the Set xlbook command in the code

Dim arrWords As Variant
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim myarray As Variant
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
    bstartApp = True
    Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("C:\path\filename.xlsx") 'Modify as necessary
Set xlsheet = xlbook.Worksheets(1)
arrWords = xlsheet.Range("A1").CurrentRegion.Value
If bstartApp = True Then
    xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
For i = LBound(arrWords) To UBound(arrWords)
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = arrWords(i)
        .Replacement.Font.Hidden = True
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .MatchCase = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Next i

[#5]

Thanks, Doug. I appreciate the extra hand. In the end, I didn't need the external document since the usage will be specific, and the number of terms won't scale over time. I am all set. Have a good one!