Writing a Word Macro to Compare Values in Two Separate Documents - vba

Question

I am attempting to write a macro that will automatically verify that the forms present in two documents are the same.
To do this I need to search through one document and create an array that is a list of all of the forms in that document. Each form is designated by a unique code like AB001 or E363. I am currently searching for these terms and highlighting them using this code I blatantly stole off the internet.
Dim word As Range
Dim wordcollection(9) As String
Dim words As Variant
'Define list.
'If you add or delete, change value above in Dim statement.
wordcollection(0) = "PJ"
wordcollection(1) = "E1233"
wordcollection(2) = "E048"
wordcollection(3) = "E144"
wordcollection(4) = "E849"
wordcollection(5) = "E977"
wordcollection(6) = "IL0021"
wordcollection(7) = "MISC001"
wordcollection(8) = "CG0001"
wordcollection(9) = "CG2107"
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow
'Clear existing formatting and settings in Find feature.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True
'Cycle through document and find words in collection.
'Highlight words when found.
For Each word In ActiveDocument.words
For Each words In wordcollection
With Selection.Find
.Text = words
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
End Sub
I need to figure out how to copy the values that are present in the document into a new array
Then I need to search another document for the same values and copy the values that are present in that document into another new array
Finally I need to compare both of the new arrays and print a list of the values that are present in new array A but not new array b and vice versa.
Any help would be appreciated. The extent of my VBA experience is writing macros to automatically copy data in formfields to new formfields so even a basic understanding of how to do this would be appreciated.
Thanks!

Answer 1

Doing a ReplaceAll in your existing code doesn't give you any runtime feedback. You have to isolate the Found variable and then you can determine what to do. My recommendation is to separate the single macro into two parts with the second macro providing the feedback that the code was found so that you can then take action.
To provide you with an example of what I am attempting to describe, below is an example and the output are separate text files that show what codes exist in each document. Hopefully you can adapt this to meet your requirements.
Sub FindCodes()
Dim doc As word.Document
Dim i As Long, wrkFolder As String, fName As String
Dim oFile As String, FileNum As Integer
Dim Codes(0 To 2) As String
Codes(0) = "PJ"
Codes(1) = "E1233"
Codes(2) = "E048"
On Error GoTo errHandler
wrkFolder = "c:\users\<your id>\documents\test\"
fName = Dir(wrkFolder & "*.docx", vbNormal)
Do While fName <> vbNullString
Set doc = Documents.Open(wrkFolder & fName)
oFile = Left(doc.FullName, InStrRev(doc.FullName, ".") - 1) & "_Codes.txt"
On Error Resume Next
Kill oFile
On Error GoTo errHandler
FileNum = FreeFile()
Open oFile For Append As #FileNum
Print #FileNum, doc.Name
For i = 0 To UBound(Codes)
If Not CheckDocument(doc, Codes(i)) = vbNullString Then
'the code was found in the document
'print it in a text file
Print #FileNum, Codes(i)
End If
Next
Close #FileNum
doc.Save
doc.Close
fName = Dir()
Loop
errHandler:
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, "Find Codes"
Err.Clear
End If
End Sub
Private Function CheckDocument(ByRef doc As word.Document, StrCode As String) As String
Dim rng As word.Range
For Each rng In doc.StoryRanges
'will search headers, footers and the document body
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.MatchCase = True
.MatchWholeWord = True
.Text = StrCode
.Wrap = wdFindStop
.Execute
If .Found Then
'this will highlight the first code found and then exit
'does it really need to highlight all places the code
'was found? If so, comment out this IF statement and
'use the loop method instead
rng.HighlightColorIndex = wdYellow
CheckDocument = .Text
Exit Function
End If
' Do While .Found
' rng.HighlightColorIndex = wdYellow
' CheckDocument = .Text
' Loop
End With
Next
End Function