Converting ranges of rows into pdf from one workbook

[green_world07]

I want to convert ranges of rows in excel to pdf file with vba.but with specific format in a different sheet. Which I have done so far. But the problem is , some how my code is ignoring the rows with similar values. I want to add all the rows with similar values under the pdf file. for example: the first image shows how the data are in the data set and second image is the format of the output and I want EmpID as input and the related rows with that EmpID will be the output and the rows will be included sequentially in the output format like the third image expected output. below I have added the code i have added in the VBA to have the pdf. The problem i am facing is it generates the output of only one row with the number for example 430 and ignores other 5 of them and it goes for the next unique number and print that because other columns related to that rows contain information which have to be included in the pdf. Thanks a lot in advance. I have tried to solve it with a dropdown list of EmpID but my file is huge(18000 list of EmpID). So i think VBA is the only option to automatize the process.

Sub pdf_test_7()

Dim i As Integer

For i = 2 To 10

Sheets("ps").Cells(1, 2) = Sheets("WD").Cells(i, 1)


Sheets("ps").Range("A1:Q25").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\Desktop\test_code_for_printing_pdf\" & Sheets("WD").Cells(i, 1) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=False

Next i


End Sub

 

[green_world07]

there is an error in assigning the pdf-name and cell(i,1) is the reason.
i is used in the other macro, but is unknown here.
Add i in the 2nd row of the module like this

Public Arr(), shPDF, Rijen, bFlag, i

But you have to add an offset in Sheets("WD").Cells(i, 1) & ".pdf".
There is a headerrow above so i think you must do ....Cells(i+1,1), the trial and error method, try +1, +2, ...

  .Range("A1:Q25").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Desktop\test_code_for_printing_pdf\" & Sheets("WD").Cells(i+1, 1) & ".pdf", _

Hi,
I am getting the same error as before in the below line:
in your code the line was with 1 to 6. why did you take 1 to 6? is it the maxm no of rows we want to see in the pdf?

 

[BSALV]

per row, you only collect 6 things, not 40, if you try it with 6, is it oké then ?

ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)

 

[green_world07]

per row, you only collect 6 things, not 40, if you try it with 6, is it oké then ?

ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)

I have tried with 6...it does not work. Do you have any idea?

 

[BSALV]

what is the value of "rijen" at that moment, so i added a msgbox there.
It isn't by accident 0 ???

   bFlag = True
  msgbox rijen
   ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)

otherwise post me the code you have now, it must be a small detail.

 

[green_world07]

what is the value of "rijen" at that moment, so i added a msgbox there.
It isn't by accident 0 ???

   bFlag = True
  msgbox rijen
   ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)

otherwise post me the code you have now, it must be a small detail.

Option Compare Text

Public Arr(), shPDF, Rijen, bFlag                                     'the array and pdfsheet that is used in both macros must be public

Sub MyLoop()
     Rijen = 40                                                'max number of rows to be exported at once, adjust if necessary

     Dim sPreviousID
     'Set Source = Sheets("input").ListObjects("A2:I46").DataBodyRange     'range of all your +100.000 rows of data (i hope it's a list otherwise small difference  !)
     Set Source = Sheets("input").Range("A2:I49")
     Set shPDF = Sheets("output")                                'name of the sheet where you copy your data

     With Source                                                'in this range
     'CAUTION : all the addresses of the cells(i,j) are relative to the topleftcell of this range !!!!!!
bFlag = False
          For i = 1 To .Rows.Count                              'loop trough all the rows
               If .Cells(i, 2) <> sPreviousID Then              'new personal number, then export and prepare for new records
                    Export_MyPDF                                'export previous employee and redim array
                    sPreviousID = .Cells(i, 2)                  'new personal ID number
                    ptr = 0                                     'reset pointer
                    shPDF.Range("B2").Value = .Cells(i, 1).Value     'new empID_Workday
                    shPDF.Range("D2").Value = .Cells(i, 3).Value     'new first name
                    shPDF.Range("F2").Value = .Cells(i, 4).Value     'new last name
               End If
               If ptr = Rijen Then MsgBox "max number of rows", vbCritical, UCase("Warning")
               ptr = Application.Min(Rijen, ptr + 1)
               Arr(ptr, 1) = .Cells(i, 2)                       '1st column personal number
               Arr(ptr, 2) = .Cells(i, 5)                       'BV
               Arr(ptr, 3) = CDbl(.Cells(i, 6))                 'start date, hopefully no problems with format
               Arr(ptr, 4) = .Cells(i, 7)                       'contract type
               Arr(ptr, 5) = .Cells(i, 8)                       'FT/PT
               Arr(ptr, 6) = .Cells(i, 9)                       'working hours
          Next
          Export_MyPDF                                          'export last employee

     End With
End Sub

Option Compare Text
Public Arr(), shPDF, Rijen, bFlag, i
Sub Export_MyPDF(Optional b)

     If bFlag Then
          With shPDF
               .Range("A5").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr     'write to collected data to that range, A10 is topleftcell of the data !!!
               .Range("A2:I49").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\ashra\Desktop\test\" & Sheets("WD").Cells(i + 1, 1) & ".pdf", _
                                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
          End With
     End If
     bFlag = True
     MsgBox Rijen
     ReDim Arr(1 To Rijen, 1 To 6)
     'ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)
End Sub

 

[green_world07]

Option Compare Text

Public Arr(), shPDF, Rijen, bFlag                                     'the array and pdfsheet that is used in both macros must be public

Sub MyLoop()
     Rijen = 40                                                'max number of rows to be exported at once, adjust if necessary

     Dim sPreviousID
     'Set Source = Sheets("input").ListObjects("A2:I46").DataBodyRange     'range of all your +100.000 rows of data (i hope it's a list otherwise small difference  !)
     Set Source = Sheets("input").Range("A2:I49")
     Set shPDF = Sheets("output")                                'name of the sheet where you copy your data

     With Source                                                'in this range
     'CAUTION : all the addresses of the cells(i,j) are relative to the topleftcell of this range !!!!!!
bFlag = False
          For i = 1 To .Rows.Count                              'loop trough all the rows
               If .Cells(i, 2) <> sPreviousID Then              'new personal number, then export and prepare for new records
                    Export_MyPDF                                'export previous employee and redim array
                    sPreviousID = .Cells(i, 2)                  'new personal ID number
                    ptr = 0                                     'reset pointer
                    shPDF.Range("B2").Value = .Cells(i, 1).Value     'new empID_Workday
                    shPDF.Range("D2").Value = .Cells(i, 3).Value     'new first name
                    shPDF.Range("F2").Value = .Cells(i, 4).Value     'new last name
               End If
               If ptr = Rijen Then MsgBox "max number of rows", vbCritical, UCase("Warning")
               ptr = Application.Min(Rijen, ptr + 1)
               Arr(ptr, 1) = .Cells(i, 2)                       '1st column personal number
               Arr(ptr, 2) = .Cells(i, 5)                       'BV
               Arr(ptr, 3) = CDbl(.Cells(i, 6))                 'start date, hopefully no problems with format
               Arr(ptr, 4) = .Cells(i, 7)                       'contract type
               Arr(ptr, 5) = .Cells(i, 8)                       'FT/PT
               Arr(ptr, 6) = .Cells(i, 9)                       'working hours
          Next
          Export_MyPDF                                          'export last employee

     End With
End Sub

Option Compare Text
Public Arr(), shPDF, Rijen, bFlag, i
Sub Export_MyPDF(Optional b)

     If bFlag Then
          With shPDF
               .Range("A5").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr     'write to collected data to that range, A10 is topleftcell of the data !!!
               .Range("A2:I49").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\ashra\Desktop\test\" & Sheets("WD").Cells(i + 1, 1) & ".pdf", _
                                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
          End With
     End If
     bFlag = True
     MsgBox Rijen
     ReDim Arr(1 To Rijen, 1 To 6)
     'ReDim Arr(1 To Rijen, 1 To 6)                              'suppose there are max 10 rows of data per employee (adjust if necessary)
End Sub

as you can see. I have only just edited your code and did not change anything significantly. but it is giving error in 'ReDim Arr(1 to Rijen, 1 to 6)' line also in the output it is changing the numbering format of "Personal number". in input sheet it was 000043 and in output sheet it returns 43.

 

[BSALV]

what give the msgbox as value, just before you received that error in the next line ?

 

[green_world07]

what give the msgbox as value, just before you received that error in the next line ?

It shows actually nothing and then it shows the error.