excel - How to make a Loop in an If-Statement

Question

Short explanation: There are 3.Letter Templates and i want them to print per Button. But the main problem here is, that the Code is Printing the Template for every Person in the Worksheet also if the Person already had a Letter. It should look something like this.

-If the selected letter in "G3" is 1. Letter then send them only to People where the Cell Range in "Z" is Empty

-If the selected letter in "G3" is 2. Letter then send them only to People where the Cell in Range "Z" is 1.Letter

-If the selected letter in "G3" is 3. Letter then send them only to People where the Cell in Range "Z" is 2.Letter

What do i need to write right here?

Thank you for your answer in Advance!

https://i.stack.imgur.com/1NRbv.png

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 OutApp, OutMail As Object
Dim WordContent As Word.Range
Dim WordDoc As Word.Document
Dim WordApp As Word.Application


With Tabelle1


    If IsEmpty(Range("G3").Value) = True Then
    MsgBox "Bitte w?hlen sie eine Vorlage aus"
    .Range("G3").Select
    Exit Sub
    End If
    TemplRow = .Range("B3").Value
    TemplName = .Range("G3").Value
    FrDays = .Range("L3").Value
    ToDays = .Range("N3").Value
    DocLoc = Tabelle2.Range("F" & TemplRow).Value


    On Error Resume Next
    Set WordApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Err.Clear
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    End If

    ***LastRow = .Range("E9999").End(xlUp).Row
        For CustRow = 8 To LastRow
            DaysSince = .Range("P" & CustRow).Value
            If TemplName <> .Range("Z" & CustRow).Value And DaysSince >= FrDays And DaysSince <= ToDays Then
               Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False)
                For CustCol = 5 To 26
                    TagName = .Cells(7, CustCol).Value
                    TagValue = .Cells(CustRow, CustCol).Value
                    With WordDoc.Content.Find
                        .Text = TagName
                        .Replacement.Text = TagValue
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With***

                Next CustCol
            If .Range("I3").Value = "PDF" Then
                FileName = "Filename" & "" & .Range("H" & CustRow).Value & " " & .Range("G" & CustRow).Value & " " & .Range("G3").Value & ".pdf"
                WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
                WordDoc.Close False
            Else:
                FileName = ThisWorkbook.Path & "" & .Range("H" & CustRow).Value & "_" & .Range("G" & CustRow).Value & ".docx"
                WordDoc.SaveAs FileName


            End If
            .Range("Z" & CustRow).Value = TemplName
            .Range("AA" & CustRow).Value = Now
        If .Range("P3").Value = "Email" Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = Tabelle1.Range("K" & CustRow).Value
                .Subject = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test"
                .Body = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test Test"
                .Attachments.Add FileName
                .Display
            End With

        Else:
        WordDoc.PrintOut
        WordDoc.Close
        End If
        Kill False '(FileName)
        End If

    Next CustRow
    WordApp.Quit
End With
End Sub

question from:https://stackoverflow.com/questions/65903613/how-to-make-a-loop-in-an-if-statement

Answer 1

Try the following: (not tested)

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

'*~
Dim sLastSentTemplate As String


With Tabelle1


    If IsEmpty(Range("G3").Value) = True Then
    MsgBox "Bitte w?hlen sie eine Vorlage aus"
    .Range("G3").Select
    Exit Sub
    End If
    TemplRow = .Range("B3").Value
    TemplName = .Range("G3").Value
    FrDays = .Range("L3").Value
    ToDays = .Range("N3").Value
    DocLoc = Tabelle2.Range("F" & TemplRow).Value

    '*~ workout the last sent template name
    '*  this is what you'll be searching for in column Z
    sLastTemplateTarget = GetLastSentTemplate(TemplName)
    
    
    On Error Resume Next
    Set WordApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Err.Clear
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    End If

    '***LastRow = .Range("E9999").End(xlUp).Row
    '*~
    LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    
        For CustRow = 8 To LastRow
            DaysSince = .Range("P" & CustRow).Value
            '*~ changed TemplName to sLastSentTemplate
            If sLastSentTemplate = .Range("Z" & CustRow).Value And DaysSince >= FrDays And DaysSince <= ToDays Then
               Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False)
                For CustCol = 5 To 26
                    TagName = .Cells(7, CustCol).Value
                    TagValue = .Cells(CustRow, CustCol).Value
                    With WordDoc.Content.Find
                        .Text = TagName
                        .Replacement.Text = TagValue
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With '***

                Next CustCol
            If .Range("I3").Value = "PDF" Then
                FileName = "Filename" & "" & .Range("H" & CustRow).Value & " " & .Range("G" & CustRow).Value & " " & .Range("G3").Value & ".pdf"
                WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
                WordDoc.Close False
            Else:
                FileName = ThisWorkbook.Path & "" & .Range("H" & CustRow).Value & "_" & .Range("G" & CustRow).Value & ".docx"
                WordDoc.SaveAs FileName


            End If
            .Range("Z" & CustRow).Value = TemplName
            .Range("AA" & CustRow).Value = Now
        If .Range("P3").Value = "Email" Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = Tabelle1.Range("K" & CustRow).Value
                .Subject = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test"
                .Body = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test Test"
                .Attachments.Add FileName
                .Display
            End With

        Else:
        WordDoc.PrintOut
        WordDoc.Close
        End If
        Kill False '(FileName)
        End If

    Next CustRow
    WordApp.Quit
    
    '*~ cleanup after finishing
    Set WordApp = Nothing
    Set OutApp = Nothing
End With
End Sub

'*~
Function GetLastSentTemplate(sTemplate As String) As String
    Dim lPrefixNumber As Long
    
    If Len(sTemplate) > 0 Then
        lPrefixNumber = Val(Left(sTemplate, InStr(sTemplate, ".") - 1))
        If lPrefixNumber > 1 Then
            GetLastSentTemplate = Replace(sTemplate, lPrefixNumber, lPrefixNumber - 1)
        End If
    End If
End Function