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