Automatically exporting subsets of data to a pdf file

[Arcinna]

So the picture below is of a sheet of data and i want to put a section of code in a macro that i already have that would export all rows with unique manifest numbers to a pdf file before the macro deletes the data on this sheet. The macro that i already have copies a selection from the 2023 sheet and inserts it on the report tab and then makes a pdf and csv file of the data before deleting it from the report sheet.

Sub Full_Order()
 
   Dim SourceRange As Range
   Dim DestinationRange As Range
   Set SourceRange = Selection
   Set DestinationRange = Worksheets("Report").Range("B14")
   SourceRange.Copy
   DestinationRange.Insert Shift:=xlDown
   Application.CutCopyMode = False
 
 
   Dim ws As Worksheet
   Dim File_Name As String
   Dim Destination As String
   Set ws = Sheets("Report")
 
   Destination = "C:\Users\User\Documents\"
   File_Name = ws.Range("G8").Value & ".pdf"
   Second_File_Name = ws.Range("G8").Value & ".csv"
   ws.ExportAsFixedFormat _
       Type:=xlTypePDF, _
       Filename:=Destination & File_Name, _
       Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, _
       IgnorePrintAreas:=False, _
       OpenAfterPublish:=False
     
   ws.SaveAs Filename:=Destination & Second_File_Name, FileFormat:=xlCSV
   Set ws = Nothing
  
   Dim rCell As Range
    Dim cRow As Long, LastRow As Long
    LastRow = Worksheets("Report").Range("E" & Rows.Count).End(xlUp).Row
    With Worksheets("Report").Range("E1", Worksheets("Report").Range("E" & Rows.Count).End(xlUp))
        Do
            Set c = .Find(What:="*P-*", After:=[E1], LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns _
            , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not c Is Nothing Then
                cRow = c.Row
                c.EntireRow.Delete
            End If
         Loop While Not c Is Nothing And cRow < LastRow
    End With
 
End Sub

this is the macro i have so far, what i am trying to add is a section that will for example take the 12th and 13th rows with the table name and column names, and then each subset of data that has a unique manifest number, so 14th & 15th or 16th-21st or 23rd-26th rows. The manifest numbers may not always be in the same format so it would have to be based on unique values in a cell and then selecting all rows with that value and the two rows from the top of the table and saving each as a pdf and repeating until it runs out of unique values. I just am not sure where to start with the loop that it would take to do it, any help even if its just pointers on where to start with it would be great.

 

[HaHoBe]

Hi Arcinna,

maybe you could use xl2BB instead of attaching pictures to make it a bit easier for everybody to copy your data in a sheet.

Regarding the deleting of rows maybe have a look at Macro to copy a selection of cells and insert it at a specific cell in a different sheet, and then export the sheet to a pdf from another thread of yours.

What about

Sub Full_Order_mod()
' https://www.mrexcel.com/board/threads/automatically-exporting-subsets-of-data-to-a-pdf-file.1228762/
 
  Dim cRow As Long
  Dim LastRow As Long
  Dim SourceRange As Range
  Dim DestinationRange As Range
  Dim rCell As Range
  Dim File_Name As String
  Dim Second_File_Name As String
  Dim Destination As String
  Dim wbNew As Workbook
  Dim wsNew As Worksheet
  Dim ws As Worksheet
  Dim arr
 
  Set SourceRange = Selection
  Set DestinationRange = ThisWorkbook.Worksheets("Report").Range("B14")
  SourceRange.Copy
  DestinationRange.Insert Shift:=xlDown
  Application.CutCopyMode = False
 
  Set ws = Sheets("Report")
 
  Destination = "C:\Users\User\Documents\"
 
  With ws
 
    File_Name = .Range("G8").Value & ".pdf"
    Second_File_Name = .Range("G8").Value & ".csv"
    .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Destination & File_Name, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
      
    .SaveAs Filename:=Destination & Second_File_Name, FileFormat:=xlCSV
 
    Set wbNew = Workbooks.Add(xlWBATWorksheet)
    Set wsNew = wbNew.Sheets(1)
 
    .Range("D13", .Cells(.Rows.Count, "D").End(xlUp)).AdvancedFilter xlFilterCopy, CopyToRange:=wsNew.Cells(1), Unique:=True
    arr = wsNew.Range("A2:A" & wsNew.Cells(wsNew.Rows.Count, "A").End(xlUp).Row)
    wsNew.Cells.Clear
   
    For lngCounter = LBound(arr) To UBound(arr)
      .Range("A13:G13").AutoFilter Field:=4, Criteria1:=arr(lngCounter, 1)
      .Range("A12", .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row, "G")).SpecialCells(xlCellTypeVisible).Copy
     
      wsNew.Paste
      wsNew.UsedRange.EntireColumn.AutoFit
      wsNew.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Destination & Format(Now, "yymmdd_hhmmss_") & arr(lngCounter, 1) & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
      wsNew.Cells.Clear
      Application.CutCopyMode = False
    Next lngCounter
    wbNew.Close False
 
    LastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
    With ws.Range("E1", ws.Range("E" & ws.Rows.Count).End(xlUp))
      Do
        Set c = .Find(What:="*P-*", After:=[E1], LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns _
        , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
          cRow = c.Row
          c.EntireRow.Delete
        End If
       Loop While Not c Is Nothing And cRow < LastRow
    End With
  End With
 
  Set DestinationRange = Nothing
  Set SourceRange = Nothing
  Set wsNew = Nothing
  Set wbNew = Nothing
  Set ws = Nothing
 
End Sub

Ciao,
Holger