Condensing code

I have a userform that allows the user to print various word documents. Before it prints the word document the program runs a find and replace routine on the document. Everything works fine. The problem is the code is the same for each document, minus the doc name and location, and BULKY. I was wondering if there was a way to condense the code, so I only had to write the repeating part once? Here is the code I have for each document (The user has access to over 50 documents)
Thank you in advance for any help.

Chunk

Code:

---

Public Sub FindAndReplace_Brief()

    Dim wrdApp As Object
    Dim wrdNNDF As Object

    Set wrdApp = CreateObject("Word.Application")
    Set wrdNNDF = wrdApp.Documents.Open("C:\BriefHist_sheet.docx")
    'CU Phase Title
    wrdNNDF.Activate
    'wrdApp.Visible = True
    wrdApp.Selection.Find.ClearFormatting
    wrdApp.Selection.Find.Replacement.ClearFormatting
    With wrdApp.Selection.Find
        .Text = "XXX"
        .Replacement.Text = tbox_CUTitle.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    'Job Order
    With wrdApp.Selection.Find
        .Text = "YYY"
        .Replacement.Text = tbox_JO.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    'Key Op
    With wrdApp.Selection.Find
        .Text = "ZZZ"
        .Replacement.Text = tbox_KO.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    wrdNNDF.PrintOut
    wrdNNDF.Close SaveChanges:=wdDoNotSaveChanges
    wrdApp.Quit
End Sub

---

You could add a parameter to the macro and call the macro with the document name. That way you only need one main code which you can call as required. e.g.

Code:

---

Option Explicit

Public Sub ProcessDocument()
    FindAndReplace_Brief "C:\BriefHist_sheet.docx"
End Sub


Public Sub FindAndReplace_Brief(strFullName As String)
Dim wrdApp As Object
Dim wrdNNDF As Object

    Set wrdApp = CreateObject("Word.Application")
    Set wrdNNDF = wrdApp.Documents.Open(strFullName)
    'CU Phase Title
    wrdNNDF.Activate
    'wrdApp.Visible = True
    wrdApp.Selection.Find.ClearFormatting
    wrdApp.Selection.Find.Replacement.ClearFormatting
    With wrdApp.Selection.Find
        .Text = "XXX"
        .Replacement.Text = tbox_CUTitle.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    'Job Order
    With wrdApp.Selection.Find
        .Text = "YYY"
        .Replacement.Text = tbox_JO.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    'Key Op
    With wrdApp.Selection.Find
        .Text = "ZZZ"
        .Replacement.Text = tbox_KO.Text
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
    wrdNNDF.PrintOut
    wrdNNDF.Close SaveChanges:=wdDoNotSaveChanges
    wrdApp.Quit
End Sub

---

gmayor,

How would that work if I have multiple documents that need to be printed (ie BriefHist_sheet.docx, Example1.docx, Example2.docx, Example3.docx)?

To allow the user to pick files to process in a batch

Code:

---

Sub FilePicker()
'Opens a Dialog box, allows User to select multiple files
'to feed to Sub FindAndReplace_Brief for processing.
'
'For help, see: http://www.vbaexpress.com/forum/showthread.php?53869-Condensing-code

    Dim FP As FileDialog
    Dim FName As Variant
   
    Set FP = Application.FileDialog( _
        FileDialogType:=msoFileDialogFilePicker)
    With FP
        .AllowMultiSelect = True
        If .Show = 0 Then Exit Sub
    End With
   
    For Each FName In FP.SelectedItems
    FindAndReplace_Brief FName
    Next FName
   
    Set FP = Nothing
End Sub

---

You can make FindAndReplace_Brief shorter by use a "Find" Array and a Replacement" array

Code:

---

FindWhat = Array("XXX", "YYY", "ZZZ")
ReplaceWith = Array(tbox_CUTitle.Text, tbox_JO.Text, tbox_KO.Text)

For i = 0 To 2
With wrdApp.Selection.Find
        .Text = FindWhat(i)
        .Replacement.Text = ReplaceWith(i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
wrdApp.Selection.Find.Execute Replace:=wdReplaceAll
Next i

---

Thanks gmayor and SamT,

I ended up using the array format to handle the Find and Replace. It works beautifully and definitely makes the code a tad bit easier to read through. Thanks again.

Chunk