Condensing code

[Chunk]

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

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

[gmayor]

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.

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

[Chunk]

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)?

[SamT]

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

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

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

[Chunk]

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