Save Excel mailmerge to PDF only on the last row with data - excel

Question

I have been using a code which uses mailmerge from the excel sheet to my word template and then proceeds to save all the rows in my excel sheet to PDF(in the word template of course). - The code works perfectly fine.
The code was taken from this forum :
https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
How my Excel sheet looks like :
A1-E1 = Headers
A2-E2 = data
A3-E3 = data
A4-E4 = data
and so on...
How the code currently works :
The code saves all rows of data from the excel sheet into my word template(with mailmerge) and then into PDFs.
My goal :
I want to change the code so it only saves the last row of data in the excel sheet into my word template(with mailmerge) and then into to PDF.
Sub RunMerge()
' Sourced from: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String
Dim i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Dim wdApp As New Word.Application, wdDoc As Word.Document
wdApp.Visible = False
wdApp.DisplayAlerts = wdAlertsNone
StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrMMDoc = StrMMPath & "MailMergeDocument.doc"
Set wdDoc = wdApp.Documents.Open(Filename:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
With .MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `Sheet1$`"
For i = 1 To .DataSource.RecordCount
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("Name")) = "" Then Exit For
StrName = .DataFields("Name")
End With
.Execute Pause:=False
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)
With wdApp.ActiveDocument
'Add the name to the footer
'.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
'.SaveAs Filename:=StrMMPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs Filename:=StrMMPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next i
.MainDocumentType = wdNotAMergeDocument
End With
.Close SaveChanges:=False
End With
wdApp.DisplayAlerts = wdAlertsAll
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
Application.ScreenUpdating = False
End Sub
Thanks in advance.

Answer 1

Replace:
For i = 1 To .DataSource.RecordCount
with:
i = .DataSource.RecordCount
or, if there are rows in use below that in other columns:
i = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row - 1
where 'A' is any column not containing data below the last record and delete both:
If Trim(.DataFields("Name")) = "" Then Exit For
and:
Next i