I'm trying to improve a macro that pulls data from a tab-separated docx file. On the document I run the macro, it finds the words on the left (from the tab-separated file), replaces them with the words on the right. I'm a beginner at programming but managed to put together something that does what I need and I spent a lot of time trying to debug and improve it.
However there's a minor thing left that doesn't sound too hard but is simply beyond me. If there's an empty line left at the end of the reference list, my macro gives the "Run-time Error 9, subscript out of range." Of course this can be solved by just deleting that empty line but I'd like to make the macro work better and ignore that somehow.
I actually have 2 different fixes in my mind but can't figure out how to implement them. It would help me even if you don't look at the whole problem and just help me learn how to implement the following fixes.
- When I run my macro on my main document, try to delete the empty lines from the reference list. But I can't figure out how to edit a document with a macro being ran on another document.
- Somehow modify the loops, so instead of "UBound - 1 to 0" and "0 to Unbound - 1", they detect the lines with characters or they ignore empty lines.
Would anyone be able to help me implement my fixes or offer another?
Macro:
Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, j As Long
'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("C:\Users\USERNAME\Desktop\refList.docx", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
FRList = FRDoc.Range.FormattedText
FRDoc.Close False
Set FRDoc = Nothing
If Split(Split(FRList, vbCr)(0), vbTab)(0) > Split(Split(FRList, vbCr)(0), vbTab)(1) Then
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
'Find text <Tab> Replace text
For j = 0 To UBound(Split(FRList, vbCr)) - 1
.Text = Split(Split(FRList, vbCr)(j), vbTab)(0)
.Replacement.Text = Split(Split(FRList, vbCr)(j), vbTab)(1)
.Execute Replace:=wdReplaceAll
Next
End With
Else
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
'Find text <Tab> Replace text
For j = UBound(Split(FRList, vbCr)) - 1 To 0 Step -1
.Text = Split(Split(FRList, vbCr)(j), vbTab)(0)
.Replacement.Text = Split(Split(FRList, vbCr)(j), vbTab)(1)
.Execute Replace:=wdReplaceAll
Next
End With
End If
Application.ScreenUpdating = True
End Sub
Edit: Trying to make it clearer below
Example:
Word file to be processed:
1
2
3
4
5
The list macro references (macro replaces the numbers on left with numbers on right)
1 2
2 3
3 4
4 5
5 6
Problem: If list has a empty line at the end like this (happens a lot when copying stuff, I wanna foolproof this), macro gives an error:
1 2
2 3
3 4
4 5
5 6
Possible fix I thought about:
- Edit the list in the macro to get rid of any empty lines. I know how to delete the empty lines but I don't know how to do that to another document (the list), while I'm running the macro from the main document.
CodePudding user response:
If, as you assume, the empty line is a result of an empty paragraph at the end of your reflist.docx, your first line of defence is to make sure that you never leave an empty paragraph at the end of that document.
Your second line of defence is to ensure that you check the range you are building FRList
from doesn't have an empty paragraph at the end, which is trivial to do.
Given that you have declared FRList
as a variant (you omitted the datatype so it is automatically assigned the default of variant) you can also make your code cleaner, and easier to read, by assigning the array output by Split
to FRList
, as I have done below.
Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRRng As Range, FRList As Variant, j As Long
'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("C:\Users\USERNAME\Desktop\refList.docx", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
FRRng = FRDoc.Range.FormattedText
If Len(FRRng.Paragraphs.Last.Range.Text) = 1 Then FRRng.MoveEnd wdCharacter, -1
FRList = Split(FRRng, vbCr)
FRDoc.Close False
Set FRDoc = Nothing
If Split(FRList, vbTab)(0) > Split(FRList, vbTab)(1) Then
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
'Find text <Tab> Replace text
For j = 0 To UBound(FRList) - 1
.Text = Split(FRList(j), vbTab)(0)
.Replacement.Text = Split(FRList(j), vbTab)(1)
.Execute Replace:=wdReplaceAll
Next
End With
Else
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
'Find text <Tab> Replace text
For j = UBound(FRList) - 1 To 0 Step -1
.Text = Split(FRList(j), vbTab)(0)
.Replacement.Text = Split(FRList(j), vbTab)(1)
.Execute Replace:=wdReplaceAll
Next
End With
End If
Application.ScreenUpdating = True
End Sub