Creating a Loop function from a repetitive line of code

Question

The code below takes a table in excel and inputs variables from columns into textboxes in a pdf template. This is done by using the sendkeys function over and over. I was wondering if there was an easy way to make this a looping function over the sendkeys section of code since I would like to be able to add many more columns/variables if necessary without having to copy and paste this code a lot.

This is all done after a button is clicked on the sheet and will run through the table while saving each created pdf to a new folder. The only part I would like to change is the long list of sendkeys to a looping function.

Thank you for any/all help!

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFldr, Desc As String
Dim custRow, LastRow As Long

With Sheet1
LastRow = .Range("A999").End(xlUp).Row     'Last Row (just set it lower than the last data row)
PDFTemplateFile = .Range("F2").Value       'Template File Name, needs to be the same as the set cell above
SavePDFFldr = .Range("F4").Value           'Save PDF Folder, needs to be the same as well
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.000004

    'CHANGE THE "LastRow" TO THE SAME NUMBER AS FIRST ROW TO TEST IF NEEDED

For CustRow = 13 To 13 ' LastRow
D1 = .Range("L" & CustRow).Value          'DEFINING THE VARIABLES AS "D##" WITH
D2 = .Range("B" & CustRow).Value          'REFERENCE TO SPECIFIC COLUMNS
D3 = .Range("AC" & CustRow).Value
D4 = .Range("C" & CustRow).Value
D5 = .Range("Y" & CustRow).Value
D6 = .Range("AB" & CustRow).Value
D7 = .Range("Z" & CustRow).Value
D8 = .Range("U" & CustRow).Value
'D9 = .Range("AA" & CustRow).Value
'D10 = .Range("AA" & CustRow).Value

Description = D4                        ' CHANGE THE D## IN THIS LINE TO THE DESCRIPTION VARIABLE FOR FILE NAME CREATION


    ' CHANGE THE "AA" TO THE ROW ASSOCIATED WITH THAT VARIABLE
    ' GET RID OF APOSTROPHE TO RELEASE FROM COMMENT LAYER

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

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

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

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

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

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

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

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

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

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

Application.SendKeys "{Tab}", True
Application.SendKeys "{Esc}", True

Application.SendKeys "^(p)", True       ' opens the print menu
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00001
Application.SendKeys "{l}", True        ' change to a landscape orientation
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Left}", True
Application.SendKeys "{Enter}", True



                                 ' *********************** BE SURE THAT PRINT TO PDF IS DEFAULT  *************************************



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

    'CHANGE THE D## IN THE BELOW LINES TO CHANGE THE NAME OF THE FILE

If Dir(SavePDFFldr & "\" & Description & ".pdf") <> Empty Then Kill (SavePDFFldr & "\" & Description & ".pdf")

    ' THE ABOVE CODE DELETES A FILE WITH THE SAME NAME IN THE FOLDER
    ' IF YOU WANT TO KEEP OLD COPIES, SAVE TO A DIFFERENT FOLDER OR MOVE THE OLDER DRAFTS

Application.SendKeys SavePDFFldr & "\" & Description & ".pdf"
Application.Wait Now + 0.00001

Application.SendKeys "%(s)"
Application.Wait Now + 0.00001

Next custRow

    ' THE FOLLOWING CODE CLOSES THE PROGRAM AND FOLDERS

Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True

End With
End Sub

PeterT · Accepted Answer · 2020-03-23 14:41:05Z

1

I believe this answers the question you implied...

Option Explicit

Sub SendResponses()
    Dim ws As Worksheet
    Set ws = Sheet1

    Dim dataColumns As Variant
    dataColumns = Split("L,B,AC,C,Y,AB,Z,U,AA", ",")

    Dim custRow As Long
    For custRow = 13 To 13
        Dim dataItem As Variant
        For Each dataItem In dataColumns
            SendData ws, custRow, dataItem
        Next dataItem
    Next custRow 
End Sub

Private Sub SendData(ByRef ws As Worksheet, _
                     ByVal thisRow As Variant, _
                     ByVal thisColumn As Variant)
    Application.SendKeys "{Tab}", True
    Application.SendKeys ws.Cells(thisRow, thisColumn).Value, True
    Application.Wait Now + 0.00001
End Sub

answered Mar 23, 2020 at 14:41

PeterT

8,5971 gold badge19 silver badges46 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

JoshL Over a year ago

Thank you for your answer, I've updated the question with a more specific question. Your answer looks like it would work but I couldn't get it to work within the code I was using.

PeterT Over a year ago

My example is still valid for your updated question. You just need to define the columns in order in an array and then inside your loop over the rows, loop through the columns. All of the SendKeys steps after entering the last item of data remains the same to set up the printing and such. If you still can't get it to work, post the code you've changed here, or in a new question and go from there.

Collectives™ on Stack Overflow

Creating a Loop function from a repetitive line of code

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related