Member Avatar for Shaun_10

Im not sure what code to use as I am not that experienced with VBA. No matter what i try i cannot get this macros to stop once it reaches a blank cell in E column.

Here is the code:

Option Explicit

Sub PDFTemplate()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFilePicker)
With PDFFldr
.Title = "Select PDF file to attach"
.Filters.Add "PDF Type Files", "*.pdf", 1
If .Show <> -1 Then GoTo NoSelection
Sheet1.Range("G53").Value = .SelectedItems(1)
End With
NoSelection:
End Sub
Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel:
Sheet1.Range("G55").Value = .SelectedItems(1)
End With
NoSel:
End Sub

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, Requestor, LastName As String
Dim ApptDate As Date
Dim CustRow, LastRow As Long
With Sheet1
If .Range("G53").Value = Empty Or .Range("G55").Value = Empty Then
MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
Exit Sub
End If

LastRow = .Range("E").End(xlUp).Row  'Last Row
PDFTemplateFile = .Range("G53").Value 'Template File Name
SavePDFFolder = .Range("G55").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00008

For CustRow = 5 To LastRow
LastName = .Range("H" & CustRow).Value 'LastName
Requestor = .Range("E" & CustRow).Value 'Requestor
ApptDate = .Range("P" & CustRow).Value 'Appt Date

Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("E" & CustRow).Value, True 'Requestor
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("F" & CustRow).Value, True 'Title
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("G" & CustRow).Value, True 'Location
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("J" & CustRow).Value, True 'Name - EE#
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("K" & CustRow).Value, True 'Position
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("L" & CustRow).Value, True 'Location#
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("M" & CustRow).Value, True 'BonusAmount
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("N" & CustRow).Value, True 'EffectiveDate
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("O" & CustRow).Value, True 'Justification
Application.Wait Now + 0.00003
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys .Range("P" & CustRow).Value, True 'Today
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001

Application.SendKeys "(^p)", True
Application.Wait Now + 0.00004
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00002

If Dir(SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf")
Application.SendKeys "%(n)", True
Application.Wait Now + 0.00002
Application.SendKeys SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf"
Application.Wait Now + 0.00002
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00004
Application.SendKeys "%{F4}", True
Application.Wait Now + 0.00004
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00004
'works up til here

Next CustRow
Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True

End With
End Sub
Edited by Reverend Jim because: Moved to programming forum
  • 2 Contributors
  • 1 Reply
  • 797 Views
  • 12 Hours Discussion Span
  • Latest Post Latest Post by ddanbe

Dani AI

Generated

— is onto the right area: the loop never sees a true "stop" because the routine that determines the last row, and/or the check for an empty cell, is not robust. Two things to fix so the macro actually stops where expected.

  1. Use a reliable LastRow and an explicit empty check. Derive the last used row from the bottom of the sheet and also test each row for a truly empty value (this handles formulas that return "" and cells that contain only spaces). Example pattern:
For r = 5 To .Cells(.Rows.Count, "E").End(xlUp).Row
    If Len(Trim(CStr(.Cells(r, "E").Value))) = 0 Then Exit For
    ' process row r
Next r
  1. Add simple guards and diagnostics before running the loop: print or MsgBox the computed LastRow, and exit early if LastRow < 5. That makes it obvious whether the last-row calculation is returning an unexpectedly large value.

Cautions and improvements

  • Cells that look blank can contain formulas, spaces or zero-length strings; the Trim/Len check above treats those as empty.
  • The current approach repeatedly opens the PDF and uses SendKeys. SendKeys is fragile because focus can change (FollowHyperlink opens an external viewer), making keystrokes land in the wrong window. For reliability consider programmatic PDF approaches (Acrobat COM if available, PDF libraries/tools, or generating PDFs from Excel/Word directly) rather than simulating keystrokes.
  • Improve indentation and add small breakpoints (F8) or Debug.Print to step through the first few rows until the loop behavior is confirmed.

Those three changes (robust LastRow, explicit empty check, and removing SendKeys) will stop the macro at the first truly blank E cell and make the process far more reliable.

Member Avatar for ddanbe

It means your calculation of LastRow is wrong. What is the value of it?
And please try to do something about your indentation.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.