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.