Pasting Value with VBA - Sorta Looping based on a multiple of 30

N

nmbc99

New Member
Joined
Apr 28, 2022
Messages
19
Office Version
  1. 365
Platform
  1. Windows
I want to create a VBA code that pastes different columns within a row to a pdf, then move to the next row and do this to 30 different rows. Then I want it to save the document then continue from where it left off. Therefore, after 30 rows have had their columns pasted into the text boxes within a pdf, it would save the document, re-open the original document then paste the next set of 30 rows.


I have the following code doing all of this until the first set of 30, but I'm not sure how to make it loop and continue it's count. Any suggestions?

VBA Code: 
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("K3").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("K6").Value = .SelectedItems(1)
End With
NoSel:
End Sub

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, PipeSupportName, Unit As String
Dim SupportRow, LastRow As Long
With Sheet1
LastRow = .Range("F2").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("K3").Value 'Template File Name
SavePDFFolder = .Range("K6").Value 'Where File will be saved
ActiveWorkbook.FollowHyperlink Address:=.Range("K3")
Application.Wait Now + 0.00006

For SupportRow = 2 To 31 'TEST ROWp

ProjectName = .Range("A" & SupportRow).Value 'Project Name
PipeSupportName = .Range("F" & SupportRow).Value 'Pipe Support Name
Unit = .Range("H" & SupportRow).Value 'Unit Number
Application.SendKeys "{Tab}", True
Application.SendKeys ProjectName, True
Application.Wait Now + 0.00002

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("B" & SupportRow).Value, True 'Project#
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("C" & SupportRow).Value, True 'System#
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("D" & SupportRow).Value, True 'Drawing #
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("H" & SupportRow).Value, True 'Unit #
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("E" & SupportRow).Value, True 'Description
Application.Wait Now + 0.00001

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

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("G" & SupportRow).Value, True 'PipeSpool/Line#
Application.Wait Now + 0.00001

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

Application.SendKeys "^(S)", True 'Control Save As
Application.Wait Now + 0.00004

Application.SendKeys .Range("F" & SupportRow).Value, True 'SupportName
Application.Wait Now + 0.00001

'Application.SendKeys "^(p)", True 'Control P
'Application.Wait Now + 0.00006

Application.SendKeys "{Enter}", True 'Enter
Application.Wait Now + 0.00005
'
'
Next SupportRow
End With
End Sub
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
I would do something like this. Where you are doing a loop that increments your start and end row by 30 each time. The loop will stop once there's no data in column A in the first run of the loop:
VBA Code: 
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, PipeSupportName, Unit As String
Dim SupportRow, LastRow As Long
Dim LoopNum As Integer
Dim StartRow As Integer
Dim EndRow As Integer
Dim StartVal As String


With Sheet1
LastRow = .Range("F2").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("K3").Value 'Template File Name
SavePDFFolder = .Range("K6").Value 'Where File will be saved
ActiveWorkbook.FollowHyperlink Address:=.Range("K3")
Application.Wait Now + 0.00006

StartRow = 2
EndRow = 31
StartVal = Range("A" & StartRow)

Do Until StartVal = ""

    For SupportRow = StartRow To EndRow   'TEST ROWp
    
        ProjectName = .Range("A" & SupportRow).Value 'Project Name
        PipeSupportName = .Range("F" & SupportRow).Value 'Pipe Support Name
        Unit = .Range("H" & SupportRow).Value 'Unit Number
        Application.SendKeys "{Tab}", True
        Application.SendKeys ProjectName, True
        Application.Wait Now + 0.00002
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("B" & SupportRow).Value, True 'Project#
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("C" & SupportRow).Value, True 'System#
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("D" & SupportRow).Value, True 'Drawing #
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("H" & SupportRow).Value, True 'Unit #
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("E" & SupportRow).Value, True 'Description
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("F" & SupportRow).Value, True 'SupportName
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("G" & SupportRow).Value, True 'PipeSpool/Line#
        Application.Wait Now + 0.00001
        
        Application.SendKeys "{Enter}", True 'Enter
        Application.Wait Now + 0.00005
        
        Application.SendKeys "^(S)", True 'Control Save As
        Application.Wait Now + 0.00004
        
        Application.SendKeys .Range("F" & SupportRow).Value, True 'SupportName
        Application.Wait Now + 0.00001
        
        'Application.SendKeys "^(p)", True 'Control P
        'Application.Wait Now + 0.00006
        
        Application.SendKeys "{Enter}", True 'Enter
        Application.Wait Now + 0.00005
    '
    '
    Next SupportRow
    
    StartRow = StartVal + 30
    EndRow = EndVal + 30
    StartVal = Range("A" & StartRow)
    
Loop

End With
End Sub
 
Upvote 0
Solution
Max1616 said:
I would do something like this. Where you are doing a loop that increments your start and end row by 30 each time. The loop will stop once there's no data in column A in the first run of the loop:
VBA Code: 
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, PipeSupportName, Unit As String
Dim SupportRow, LastRow As Long
Dim LoopNum As Integer
Dim StartRow As Integer
Dim EndRow As Integer
Dim StartVal As String


With Sheet1
LastRow = .Range("F2").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("K3").Value 'Template File Name
SavePDFFolder = .Range("K6").Value 'Where File will be saved
ActiveWorkbook.FollowHyperlink Address:=.Range("K3")
Application.Wait Now + 0.00006

StartRow = 2
EndRow = 31
StartVal = Range("A" & StartRow)

Do Until StartVal = ""

    For SupportRow = StartRow To EndRow   'TEST ROWp
   
        ProjectName = .Range("A" & SupportRow).Value 'Project Name
        PipeSupportName = .Range("F" & SupportRow).Value 'Pipe Support Name
        Unit = .Range("H" & SupportRow).Value 'Unit Number
        Application.SendKeys "{Tab}", True
        Application.SendKeys ProjectName, True
        Application.Wait Now + 0.00002
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("B" & SupportRow).Value, True 'Project#
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("C" & SupportRow).Value, True 'System#
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("D" & SupportRow).Value, True 'Drawing #
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("H" & SupportRow).Value, True 'Unit #
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("E" & SupportRow).Value, True 'Description
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("F" & SupportRow).Value, True 'SupportName
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Tab}", True
        Application.SendKeys .Range("G" & SupportRow).Value, True 'PipeSpool/Line#
        Application.Wait Now + 0.00001
       
        Application.SendKeys "{Enter}", True 'Enter
        Application.Wait Now + 0.00005
       
        Application.SendKeys "^(S)", True 'Control Save As
        Application.Wait Now + 0.00004
       
        Application.SendKeys .Range("F" & SupportRow).Value, True 'SupportName
        Application.Wait Now + 0.00001
       
        'Application.SendKeys "^(p)", True 'Control P
        'Application.Wait Now + 0.00006
       
        Application.SendKeys "{Enter}", True 'Enter
        Application.Wait Now + 0.00005
    '
    '
    Next SupportRow
   
    StartRow = StartVal + 30
    EndRow = EndVal + 30
    StartVal = Range("A" & StartRow)
   
Loop

End With
End Sub
Click to expand...
Minus the 1 tweak to correct the variables that are keeping the count, so to speak, at the bottom
VBA Code: 
StartRow = StartRow + 30
    EndRow = EndRow + 30
    StartVal = Range("A" & StartRow)

This code worked exactly how I needed it too! Thank you so much! I didn't think to use a Do Until loop. I was trying to figure it out with for and while loops and that wasn't panning out. Therefore, I had to go back to what was working - which was hard coding the range - but that wasn't going to cut it once the lists got into the thousands
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Populate PDF checkbox with Application.SendKeys " "
Replies
0
Views
239
alxn
A
J
  • Question
COMPILE ERROR: End With without With
Replies
5
Views
385
HaHoBe
HaHoBe
R
  • Solved
Macro that copies Excel data into pdf field doesn't always paste all the data
Replies
3
Views
631
RickOlson
R
A
  • Question
I'm trying to create a Macro to use sendkeys command to copy the value of a cell and paste on another application. It goes like this:
Replies
0
Views
659
Abulean2010
A
C
  • Question
Help saving a autopopulate .pdf
Replies
0
Views
833
cskelk
C

Forum statistics

Threads
1,215,069
Messages
6,122,952
Members
449,095
Latest member
nmaske

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top