11
\$\begingroup\$

Today I created a script in Excel that migrates data from a specific Word document and copies a portion of it to a cell in Excel (the date to be specific).

The file input is

Last name, First Name, Grade - (Rank) (Completed On YYYY-MM-DD HH:mm:ss)

and each person is on a new "paragraph" (aka line) in Word.

Sub SearchTextFile()
Dim i As Integer
Dim currentCellNumberLname As String
Dim currentCellNumberFname As String
Dim currentCellData As String
Dim firstPlusLastName As String
Dim filePath As String
filePath = "C:\Users\<user>\Desktop\CyberAwareness.docx"

For i = 2 To 4
    currentCellNumberLname = "C" & i
    currentCellNumberFname = "D" & i
    currentCellToAdd = "L" & i
    ActiveSheet.Range(currentCellToAdd).Activate
    ActiveWindow.ScrollRow = ActiveCell.Row
    firstPlusLastName = Range(currentCellNumberLname).Value & ", " & Range(currentCellNumberFname).Value
    Range(currentCellToAdd) = SearchWordDoc(filePath, firstPlusLastName)
Next
End Sub

'Searches word file for name, finds the associated paragraph, and returns the date'
Function SearchWordDoc(strPath, strName)
Set objword = CreateObject("word.application")
Set a = objword.documents.Open(strPath)

For i = 1 To a.Paragraphs.Count
    If InStr(a.Paragraphs(i).Range.Text, strName) <> 0 Then
        SearchWordDoc = Left(Right(a.Paragraphs(i).Range.Text, 22), 11)
    End If
Next i
a.Close
objword.Quit
'    objword.Visible = False'
Set objword = Nothing
End Function

I have about 300 personnel that need information entered into this document and about 8 different columns I need to populate. The script works surprisingly well, however, it is pretty slow and takes ~10 minutes for one column. I'm fine with it since it gets the job done, but I'm curious if there is any way to streamline it further and possibly add error checking (for name mismatches).

\$\endgroup\$
6
\$\begingroup\$

General Notes

First - In addition to replacing the magic numbers, I'd put your file path into a constant at the top of the module for easier maintenance:

Private Const WORD_DOCUMENT_LOCATION As String = "C:\Users\<user>\Desktop\CyberAwareness.docx"

Second - Get a reference to the Worksheet object at the start of the function instead of relying on calls to ActiveSheet. Nothing will make the wheels come off of a long function faster than the user doing something that changes the active Workbook or Worksheet in the middle of your execution.

Dim sheet As Worksheet
Set sheet = ActiveSheet

Third - Using Range addressing C2 or L3 is not only harder to read, it is less efficient as well. Not only do you have to concatenate strings in order to build the addresses, Excel just has to convert them back into numeric indexes. Unless you have a really good reason not to do so, using .Cell(row, column) is almost always better and is much easier to use in loops.

'Instead of this...
sheet.Range("A" & i).Value = foobar
'...do this:
sheet.Cells(i, 1).Value = foobar

Fourth - Get into the habit of declaring the scope of your Subs and Functions to make sure that you are only exposing the ones that you intend to. If you leave these off, they will default to public and start showing up in your function list in the Workbook and be available for auto-complete. If it isn't something you would want to show up in a cell, i.e. =SearchWordDoc("this raises","an error"), declare it as Private.

Finally - Declare your function return types. It isn't clear what the code below returns, and the comment makes it worse - it doesn't return a Date at all, it returns a String.

'Searches word file for name, finds the associated paragraph, and returns the date'
Function SearchWordDoc(strPath, strName)

Taken in conjunction with the item above, the function declaration should really be something like this:

Private Function SearchWordDoc(filepath, name) As String

Performance

As @RubberDuck noted, the biggest performance boost you're going to get is from not repeatedly opening and closing the Word document. Most of the other suggestions are spot on, so I'll limit this answer to the performance aspect of the code.

Based on your existing code, it is apparent that there is only one line per person in your Word document and all of the lines have (or should have) the same structure. What you are essentially doing is performing a lookup on a Word file based on a key. VBA has an object that is designed to perform key lookups that are orders of magnitude faster than Word's .Find method - Scripting.Dictionary. All you need to do is parse the document first as text to build your object. For example (with a reference to Microsoft Scripting Runtime):

Private Function LoadWordRecords(filepath As String) As Scripting.Dictionary

    Dim host As New Word.Application
    Dim doc As Word.Document
    Dim lines() As String

    Set doc = host.Documents.Open(filepath)
    'Take the whole document in one shot, and read to an array of paragraphs...
    lines = Split(doc.Content.text, vbCr)
    '...and dispense with Word.
    doc.Close
    host.Quit

    'Then do whatever you need to do to parse the text into a useful structure:
    Dim output As New Scripting.Dictionary
    Dim items() As String
    Dim i As Integer

    'Parse each line in the Word document to extract a key for the line.
    For i = 0 To UBound(lines)
        'Add whatever you need to validate the paragraph you're parsing.
        'Test the input line to see if it contains a comma.
        If (InStr(1, lines(i), ",") > 0) Then
            'Split into an array from the comma delimited string.
            items = Split(lines(i), ",")
            'Add the resulting item to the Dictionary with the key defined
            'as the first 2 elements and the value as the remainder of the line.
            Call output.Add(Trim$(items(0)) & ", " & Trim$(items(1)), items(2))
        End If
        'Or whatever is convenient.
    Next i

    Set LoadWordRecords = output

End Function

Then, all you have to do in the calling code is grab the Dictionary from your parsing function and grab the lines as needed based on the keys:

Public Sub SearchTextFile()

    Dim sheet As Worksheet
    Set sheet = ActiveSheet

    Dim i As Integer
    Dim currentCellNumberLname As String
    Dim currentCellNumberFname As String
    Dim currentCellData As String
    Dim firstPlusLastName As String

    'Load your lookup object:
    Dim entries As Scripting.Dictionary
    Set entries = LoadWordRecords(WORD_DOCUMENT_LOCATION)

    For i = 2 To 4
        currentCellNumberLname = "C" & i
        currentCellNumberFname = "D" & i
        currentCellToAdd = "L" & i
        ActiveSheet.Range(currentCellToAdd).Activate
        ActiveWindow.ScrollRow = ActiveCell.row
        firstPlusLastName = sheet.Range(currentCellNumberLname).Value & ", " & sheet.Range(currentCellNumberFname).Value

        'Retrieve lines by keys for parsing:
        sheet.Range(currentCellToAdd) = Left(Right(entries(firstPlusLastName), 22), 11)
    Next

End Sub

My rule of thumb is that Windows COM calls are generally expensive, and are best avoided if alternatives exist. This should be finishing on the order of seconds not minutes, and the majority of the processing time should be coming from simply opening the Word document.

\$\endgroup\$
  • 1
    \$\begingroup\$ Welcome back, and have an upvote! \$\endgroup\$ – syb0rg Sep 16 '14 at 1:54
  • \$\begingroup\$ Thanks a lot! I'm kind of stumbling along at the moment, learning as I go but this gives me some great stuff to work with! I'm currently working on automating the script further and having it do multiple files, so I'll probably have a bunch more questions tomorrow. I'll see if I can implement some of your suggestions too, especially the dictionary. \$\endgroup\$ – slow_excellence Sep 16 '14 at 2:20
  • \$\begingroup\$ Could you explain what is going on in the for loop within the function for loading the dictionary? I keep getting "Invalid procedure call or Argument" when it reaches the if part. \$\endgroup\$ – slow_excellence Sep 16 '14 at 14:25
  • \$\begingroup\$ @slow_excellence - Updated with more comments in that section. Error was my fault - I let the fact that VBA uses 1 based indexing slip my mind last night. \$\endgroup\$ – Comintern Sep 16 '14 at 22:42
5
\$\begingroup\$

Performance

I see three major issues with the performance of this code.

  1. GUI operations are expensive and slow. Remove these lines, they're doing nothing but slowing you down.

    ActiveSheet.Range(currentCellToAdd).Activate
    ActiveWindow.ScrollRow = ActiveCell.Row
    

    You should avoid using activate and select anyway. They tend to lead to nasty bugs.

  2. Don't loop through all of the text in the word document. Find it instead. Here's some pseudo code to get you started.

    Dim doc as Document
    Dim currentRange as Range
    
    Set doc = ActiveDocument
    Set currentRange = doc.Range
    
    With currentRange.Find
        .Forward = True
        .Text = strName
        .Execute 'execute will update current range to the first found instance
    
        If .Found Then
            SearchWordDoc = currentRange.Text ' in reality, I suspect you'll need to offset this
        End If
    End With    
    

    If you're interested, you can take a look at this example of using Range.Find in word.

  3. You create a new instance of Word and open the same document up each time you call the SearchWordDoc function. Both creating an instance of Word and opening documents are slow and expensive operations. You should instance Word and open the doc inside of SearchTextFile and pass the document as an argument.

Other Notes

  • Ditch the Hungarian notation. You're not doing it right, but don't feel bad. No one really does.

  • Replace Magic Numbers with meaningfully named constants.

    For i = 2 To 4

    I imagine firstColumn and lastColumn would be good here.

  • You should start using Option Explicit. It forces you to declare all of your variables. This means that everything will be strongly typed, which is good. It stops a lot of nasty run-times errors from ever happening.

  • I highly recommend that you use early binding instead of late binding. It's kind of a debated topic, but I think the benefits outweigh the drawbacks. Just having intellisense alone makes early binding worth it in my mind.

Quick Performance Boost

Inside of SearchWordDoc you can declare i as a static variable. This will allow i to retain it's value in between executions. This is, in effect, keeping track of the last paragraph where you found what you were looking for. However, be warned that static variables make code confusing and hard to debug. I don't recommend it as a long term solution.

\$\endgroup\$
  • \$\begingroup\$ There are a few other things I could mention, but I have to go for now. Maybe I'll come back and update this later. \$\endgroup\$ – RubberDuck Sep 11 '14 at 19:56
  • 1
    \$\begingroup\$ First, I'd like to thank you for your input! I'll try fiddling with Range.Find later since my boss wants the information ASAP. Second, I noticed that the program gets exponentially slower the farther down the list it gets (~5s per entry near the top, ~1min near the bottom). I believe this is caused by the paragraph loop I have within my function. Is there any way that I can change 'i = 1' to 'i = last successful iteration of i' so it doesn't have to re-check successful entries? \$\endgroup\$ – slow_excellence Sep 11 '14 at 20:11
  • \$\begingroup\$ @slow_excellence I added an "Immediate Performance Boost" section. \$\endgroup\$ – RubberDuck Sep 11 '14 at 20:25
  • 1
    \$\begingroup\$ I'd recommend a module-level variable instead of a method-level static one. static locals in VBA are really just badly placed instance-level data. \$\endgroup\$ – Mathieu Guindon Sep 11 '14 at 20:31
  • 1
    \$\begingroup\$ I agree @Mat'sMug, but declaring the local variable static is the most minimal change that can be made for a quick boost. @slow_excellence, You should create the instance of Word in the excel portion of your code and pass it into SearchWordDoc. Your code wants to open up a new instance of word each time the function is called. It takes a lot of time to open word, so that should be avoided. \$\endgroup\$ – RubberDuck Sep 11 '14 at 20:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.