My Macro’s code needs something to speed it up (MS word / VBA)

Topic

New Reply

I have created a template that works a bit like Synonyms in Word. My first macro which is the part i am having problems with takes a bit too long to run. When I run the Macro it checks to see if any words in the current document match those of a text file (word list) that I have. if it finds a match it underlines the word ready for me to run another Macro on it. The text file has around 1000 rows and each row has 2-5 words on it sepearated by a tab.

I have been around looking for help and the code I have pasted below is the fastest so far (but still a bit slow). Does anyone have any ideas to speed it up even more?

Sub FindHomonyms()
Dim oRg As Range
Dim LineFromFile As String, LineString As String
Dim WordArray As Variant
Dim indx As Integer, LparenPos As Integer, RparenPos As Integer
Dim WholeDocument As String

Open “c:tempdata.txt” For Input As #1
Do While Not EOF(1)
Line Input #1, LineString
LparenPos = InStr(LineString, “(“)
Do While LparenPos > 0
RparenPos = InStr(LparenPos, LineString, “)”)
If RparenPos > 0 Then
LineString = Left(LineString, LparenPos – 2) & _
Right(LineString, Len(LineString) – RparenPos)
LparenPos = InStr(LineString, “(“)
End If
Loop
LineFromFile = LineFromFile & vbTab & LineString
Loop
Close #1

WordArray = Split(LineFromFile, vbTab)

Set oRg = ActiveDocument.Range

Application.ScreenUpdating = False

With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Underline = wdUnderlineWavyHeavy

.Replacement.Text = “^&” ‘ 0 Then
.Text = WordArray(indx)
.Execute Replace:=wdReplaceAll
End If
StatusBar = UBound(WordArray) – indx
DoEvents
Next indx
End With

Application.ScreenUpdating = True
End Sub

If I haven’t explained anything clear enough please post back

Richi

Reply | Quote

Replies

I’m not surprised that that several hundred Find/Replace operations run slowly. I’m not sure there is any way to improve the operation using Word’s native tools. There is a RegExp (regular expressions) engine in the VBScript library that might be more flexible in narrowing down the set of words to highlight. See Post #88215 for some sample code and a link. You can’t actually use RegExp to edit the document; as you would suspect, it munges the formatting. But if you could find a way to turn your file into a few massive pattern strings, and get back an array of the found words, that might put you a few cycles ahead.

If you are using XP, you might look into Smart Tags. I don’t use XP, but from reading about them a bit, they would allow you to hook up code to a particular word. Problem is, do you need 2500 Smart Tags to make it work?

P.S. Where do you set the content of the string WholeDocument?

Reply | Quote

If your document is pretty simple (no tables, no fields), you might try to get by with Instr, and not use Find/Replace at all.

If ActiveDocument.End = Len(WholeDocument), then you can manipulate the formatting directly. Say you’ve found with Instr that one of the words of length 5 appears at a position 12, you could directly format the corresponding Range:
ActiveDocument.Range(12,12+5).Font.Underline=wdUnderlineSingle

This method will probably only speed up your macro if most words appear rarely or not at all in your document(s).

Klaus

Reply | Quote

A few ideas.

Make WordArray a string array, not variant. Though any difference in performance may be negligible.

You might get some false matches in the “instr”. “The” in the wordAdday will trigger a match on “there”; this will not replace, but it will trigger the replace operation. You might also miss a match if your input file has a word with a letter in upper case- though that would be easy to solve.

Perhaps something like this might work:

Dim lngIndex As Long
Dim strWord As String

LineFromFile = LCase$(LineFromFile) & vbTab
For lngIndex = 1 To ActiveDocument.Words.Count
    strWord = Trim$(LCase$((ActiveDocument.Words(lngIndex).Text)))
    
    If InStr(LineFromFile, vbTab & strWord & vbTab) > 0 Then
      ActiveDocument.Words(lngIndex).Font.Bold = True
    End If
Next

Reply | Quote

Hi all

Sorry I have not got back sooner!

Geoff, which part of my code needs to be replaced with your code? I am a bit of a beginner.

Howard, thanks for giving me the code to try but unfortunately it was very very slow.

If it would be easier to have a look at the text file and the template to give you a better idea please e-mail me and I will send them to you. richiwatts@hotmail.com

Thanks again for all the advice so far.

Reply | Quote

The code proposed by Geof would be much slower than using Find. Going thru a doc using the Words collection is very, …, very slow.

Klaus’ s suggestion would be faster, but, as he says, can be used ONLY if the document is, in effect just text with no fields, etc.

The code I posted can be looked at as follows:

1. The first part of the code reads a file. Other than trying API calls, there can be no speed improvement in reading the file if you must use Line Input #. If you could change the file so that you could use Input #, you would likely see some improvement.

2. Not knowing the actual structure of your data, I cannot suggest ways to improve the inner Do … While.
In addition, there might be a possibility of restructuring the data in the file to enable the code to run faster.
As I recall, I tought I noticed a bug in that code and corrected the code so it is ar least as fast as whatever you were running.

3. It might be possible to do the above changes and eliminate the need for Split.

4. Given the info presented, there is no way to speed up the Find code.

5. You could eliminate the StatusBar statement. It’s not really needed unless you are debugging.

Reply | Quote

Bye thee way.

What OS?
What version of Word?
What speed CPU?
How much memory for computer?
How big is the paging file?

Reply | Quote

Hi Howard,

At work I have ME, word 2000, PIII, 128 MB
At home W98, word 97, PIII, 128 Mb

My computer at home is currently being repaired so I have not had a chance to try it out on the older system yet. I am also told that the Split function only works with Word 2000 and up. You mentioned changing the split function, if you have any ideas that will allow this template to work in an older version that would be great.

With regards to the documents I get to check well they come in all shapes and forms so I need to allow for the checking of text boxes, tables etc. Someone had previously supplied me with a bit of code with the Instr method and it was very fast but matched thing completely wrong.

You mentioned that you noticed a bug in the code, Was that in the code I posted originally?

What do you think my options are?

Many thanks
Richi

Reply | Quote

You can program your own split function.

You can change the format of the file so you can use Input instead of Line Input.
You can change the structure of the file to, perhaps, enable more efficient input.
Without seeing the data, not much more I can say.

Yes, pulling the doc into a string, as both Klaus and I indicated, won’t work in the general case.

I cannot take the time to describe why I changed your Do While.

I suggest the following, start with my suggested code and:

1. Put in code to time the code that is reading the file.

2. Put in code to time the For Next with the Replace operation. There’s really no way to speed this up. You have a loop that is run once for each element of the array and uses only a single Execute method.

Without actually seeing the data and analyzing the structure of the file, it’s difficult to make further suggestions.
Perhaps you need to retain sombody’s services to look deeper? Several of us would be willing to fatten our piggy banks.

Of course, 128MB is not much these daze, so the problem could also be caused by other apps running on your system that are fighting for memory.

If you plan on doing significant VBA programming, you really should replace Office 97 with Office 2000 or Office XP, if only to have things such as Replace/Split functions, Application.Run with args, and modeless userforms. Not to mention that you have Office 2000 at work and Office 97 at home, why not eliminate potential incompatibilities? If your employer wants you to take work home, they should get you a license for Office 2000 (or Office XP).

Reply | Quote

“Perhaps you need to retain sombody’s services to look deeper? Several of us would be willing to fatten our piggy banks.”

Unforunately my piggy bank isn’t too big which is why I have been trying to do this myself. But there could be a drink in it for someone.

Reply | Quote

It’s trade off between keeping on’e piggy bank full and time.

Your situation likely cannot be improved without somebody analyzing your data and file set up.

Reply | Quote

Does the following work?
Is it faster than …?

Option Explicit
' Revised by Howard Kaikow: 13 September 2002

Sub RevisedFindHomonyms()
    Dim indx As Integer
    Dim intFileNumber As Integer
    Dim LineFromFile As String
    Dim LineString As String
    Dim lngUboundArray As Long
    Dim LparenPos As Integer
    Dim RparenPos As Integer
    Dim WordArray() As String
    
    LineFromFile = ""
    intFileNumber = FreeFile
    Open "c:tempdata.txt" For Input As #intFileNumber
    Do While Not EOF(intFileNumber)
        Line Input #intFileNumber, LineString
        LparenPos = InStr(LineString, "(")
        Do While LparenPos > 0
            RparenPos = InStr(LparenPos, LineString, ")")
            If RparenPos > 0 Then
                LineString = Left(LineString, LparenPos - 2) & _
                    Right(LineString, Len(LineString) - RparenPos)
                LparenPos = InStr(LineString, "(")
            End If
        Loop
        LineFromFile = LineFromFile & LineString & vbTab
    Loop
    LineFromFile = Left$(LineFromFile, Len(LineFromFile) - 1)
    
    Close #intFileNumber
    
    WordArray = Split(LineFromFile, vbTab)
    lngUboundArray = UBound(WordArray)
        
    Application.ScreenUpdating = False
    
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineWavyHeavy
            .Text = ""
        End With
        For indx = 0 To lngUboundArray
            .Execute findtext:=WordArray(indx), Replace:=wdReplaceAll
            StatusBar = lngUboundArray - indx
        Next indx
    End With
    
    Application.ScreenUpdating = True
End Sub

Reply | Quote