I've got stucked with the following problem: a workbook contains a worksheet called "names". It has columns with name & surname, name in eng, name in rus and sex of the employee and the code. The code is supposed to get values from the columns, then it creates an arrays and the it loops through these arrays and it should change the values on the other sheet accordinagly like employee 1, name of employee 1, ... code for employee 1, employee 2, name of employee 2, ... code of employee 2 but it does in the following way: employee 1, name of employee 1, ... code for employee 1, employee 1, name of employee 1, ... code of employee 2, employee 1, name of employee 1, ... code of employee 3 and etc. It's obvious that I've lost the piece of code that should make it in a supposed way, but I can't find it.

The code is below. Thank you very much in advance!

Sub SaveAsPDF()

Dim ws As Workbook
Dim nm As Worksheet
Dim last_row As Long
Dim names_surname, name, sex, promocode As Variant
Dim Certificate As Worksheet
Dim FilePath As String

Set ws = ThisWorkbook
Set nm = ws.Sheets("Names")

With nm
    last_row = .Range("A1").CurrentRegion.Rows.Count
    names_surname = Application.Transpose(nm.Range("E2:E" & last_row).Value2)
    name = Application.Transpose(.Range("F2:F" & last_row).Value2)
    sex = Application.Transpose(.Range("G2:G" & last_row).Value2)
    promocode = Application.Transpose(.Range("H2:H" & last_row).Value2)
End With

Set Certificate = ws.Sheets("Certificate_PDF")
FilePath = "C:\Users\name\folder\2021\Desktop\Certificates"

For Each ns In names_surname
    For Each n In name
        For Each s In sex
            For Each p In promocode
                If s = "mr" Then
                    Certificate.Range("Name").Value = "Dear, " & n & "!"
                Else
                    Certificate.Range("Name").Value = "Dear, " & n & "!"
                End If
                    Certificate.Range("Promo").Value = "Code: " & p
                    Certificate.PageSetup.Orientation = xlPortrait
                    Certificate.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FilePath & "\" & ns & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False

                Next p
            Next s
        Next n
    Next ns

MsgBox "Completed", vbInformation

End Sub

CodePudding user response：

Don't nest the loops, just loop through the one 2-D array.

Option Explicit
Sub SaveAsPDF()

    Dim wb As Workbook
    Dim wsNm As Worksheet, wsCert As Worksheet
    Dim last_row As Long
    Dim ar As Variant
    Dim FilePath As String
    
    Set wb = ThisWorkbook
    Set wsNm = wb.Sheets("Names")
    With wsNm
        last_row = .Cells(.Rows.Count, "E").End(xlUp).Row
        ar = .Range("E2:H" & last_row).Value2
    End With
    
    Set wsCert = wb.Sheets("Certificate_PDF")
    FilePath = wb.Path '"C:\Users\name\folder\2021\Desktop\Certificates"
    
    Dim i As Long, fullname As String, name As String, sex As String, promocode As String
    For i = 1 To UBound(ar)
        fullname = ar(i, 1) ' E name surname
        name = ar(i, 2) ' F
        sex = ar(i, 3) ' G
        promocode = ar(i, 4) 'H
        
        With wsCert
            If sex = "mr" Then
                .Range("Name").Value = "Dear, " & name & "!"
            Else
                .Range("Name").Value = "Dear, " & name & "!"
            End If
            .Range("Promo").Value = "Code: " & promocode
            
            ' export as pdf
            .PageSetup.Orientation = xlPortrait
            .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=FilePath & "\" & fullname & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False
       End With
    Next
    
    MsgBox UBound(ar) & " pdfs generated", vbInformation
End Sub