Option Explicit

Sub CreateWordDocuments()
Dim CustRow, CustCol, LastRow, TemplRow, DaysSince, FrDays, ToDays As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim CurDt, LastAppDt As Date
Dim WordDoc, WordApp, OutApp, OutMail As Object
Dim WordContent As Word.Range

With Sheets("QA Selection")
If .Range("B3").Value = Empty Then
    MsgBox "Please select a correct template from the drop down list"
    .Range("G3").Select
 Exit Sub
End If

TemplRow = .Range("B3").Value 'Set Template Row
TemplName = .Range("G3").Value 'Set Template Name
FrDays = .Range("K4").Value 'Set From Days
ToDays = .Range("M4").Value 'Set To Days
DocLoc = Sheet2.Range("F" & TemplRow).Value 'Word Document Filename

'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Erro_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If

LastRow = .Range("D99999").End(xlUp).Row 'Determine Last Row in Table
        For CustRow = 7 To LastRow
        DaysSince = .Range("I" & CustRow).Value
If DaysSince <= FrDays And DaysSince >= ToDays Then
        Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc)
'Open Template
    For CustCol = 4 To 16 'Move through 11 columns
        TagName = .Cells(5, CustCol).Value 'TagName
        TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
        With WordDoc.Content.Find
            .Text = TagName
            .Replacement.Text = TagValue
            .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue 'Find and Replace all Instances
        End With
Next CustCol

If .Range("I3").Value = "PDF" Then
    FileName = ThisWorkbook.Path & "" & .Range("D" & CustRow).Value & "_" & .Range("H" & CustRow).Value & ".pdf" 'Create full file name & Path with current workbook locations, Full Name and date
            WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
            WordDoc.Close False

    Else: 'If Word
        FileName = ThisWorkbook.Path & "" & .Range("D" & CustRow).Value & "_" & .Range("H" & CustRow).Value & ".docx"
        WordDoc.SaveAs FileName
End If
If .Range("O3").Value = "Email" Then
    Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
    Set OutMail = OutApp.CreateItem(0) 'Create Email
        With OutMail
            .To = Sheets("QA Selection").Range("P" & CustRow).Value
            .Subject = "Side by Side for " & Sheets("QA Selection").Range("D" & CustRow).Value & Sheets("QA Selection").Range("H" & CustRow).Value
            .Body = Sheets("QA Selecetion").Range("F" & CustRow).Value & " It was great sitting with you on " & Sheets("QA Selection").Range("H" & CustRow).Value & "! I wanted to go over a few things I noticed. You can find some Areas of Opportunity and where you succeed in the attached document! Please let me know if you have any questions, " & Sheets("QA Selection").Range("E" & CustRow).Value
            .Attachments.Add FileName
            .Display 'To Send without Displaying change .Display to .Send
        End With

Else: 'Print Out
    WordDoc.PrintOut
    WordDoc.Close
End If
End If
Next CustRow
WordApp.Quit
End With
End Sub