Macro to Select and Print Worksheets Based on Unique Identifier in Worksheet Name

[JHCali]

Hi Everyone,

I am creating an Excel workbook in which certain worksheets need to print to pdf. There are many worksheets in the workbook with the naming convention below:

DATA_<Worksheet Name 1>
PP_<Worksheet Name 1>
DATA_<Worksheet Name 2>
PP_<Worksheet Name 2>
.
.
.
DATA_<Worksheet Name n>
PP_<Worksheet Name n>

I am wondering if I can create a macro that goes through the list of worksheets, selects those that begin with "PP_", and prints those to pdf based on the print area for those respective worksheets. This way, even if I add more worksheets, I can have the macro pick them up for printing so long as their name starts with "PP_".

Thank you all very much in advance for any help you can provide.

Regards,
JH

 

[Skyybot]

Try this. Test on a COPY of your Workbook. Paste the code into ThisWorkbook code module of the VBA Project.

Option Explicit

Sub PrintSheets()
Dim wb As Workbook, sht As Worksheet

Set wb = ThisWorkbook

For Each sht In wb.Sheets
    If Left(sht.Name, 2) = "PP" Then sht.PrintOut PrintToFile:=True, PrToFileName:="C:\Users\" & Application.UserName & _
        "\Documents\" & sht.Name & ".pdf"
Next sht

End Sub

 

[JHCali]

Hi,

Thanks so much for that code. If I am reading it correctly, it creates a separate print out for each sheet name. Is there a way to create the macro that groups all the Sheets with "PP" together and prints it as one packet?

Also, is there any way to stop the macro at the print preview button so that the user can specify the filename and file location for the printout?

Regards,
JH

 

[Skyybot]

If you're looking for users to specify file name and location, then why not use SaveAs instead of Print? I don't think I understand exactly what you want to do.

 

[Skyybot]

See if this does what you need.

Option Explicit



Sub PrintSheets()
Dim wb As Workbook, sht As Worksheet, shts(), i As Integer
Dim fName As String
Set wb = ThisWorkbook

For Each sht In wb.Sheets
    If Left(sht.Name, 2) = "PP" Then
        ReDim shts(i)
        shts(i) = sht.Name
        i = i + i
    End If
Next sht
wb.Sheets(Join(shts, ",")).Select
fName = Application.GetSaveAsFilename
ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    fName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

 

[JHCali]

Hi,

SaveAs would be a perfectly fine option instead of Print. I tried the revised code, but I get an error message saying: Compile error. Sub or Function Not Defined. Furthermore, the Sub PrintSheets() is highlighted yellow and the ExportAsFixedFormat is also highlighted.

Regards,
JH

 

[Sanjeev1976]

You can try the below :

Sub Save_Sheets_Starting_With_PP_As_PDF()
    Dim ws As Worksheet
    Dim wsArray() As String
    Dim sheetName As String
    Dim searchText As String
    Dim i As Integer
    Dim savePath As String
    
    ' Set the text that the sheet names should start with
    searchText = "PP"
    
    ' Set the path where the PDF will be saved
    savePath = ThisWorkbook.Path & "\SelectedSheets_PP.pdf"
    
    ' Loop through all sheets and collect the names of sheets starting with the search text
    i = 0
    For Each ws In ThisWorkbook.Sheets
        sheetName = ws.Name
        If Left(sheetName, Len(searchText)) = searchText Then
            ReDim Preserve wsArray(i)
            wsArray(i) = sheetName
            i = i + 1
        End If
    Next ws
    
    ' Check if any sheets were found
    If i > 0 Then
        ' Export the selected sheets as a single PDF
        ThisWorkbook.Sheets(wsArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, Quality:=xlQualityStandard
        MsgBox "PDF saved successfully at: " & savePath
    Else
        MsgBox "No sheets found starting with: " & searchText
    End If
End Sub

 

[JHCali]

You can try the below :

Sub Save_Sheets_Starting_With_PP_As_PDF()
    Dim ws As Worksheet
    Dim wsArray() As String
    Dim sheetName As String
    Dim searchText As String
    Dim i As Integer
    Dim savePath As String
   
    ' Set the text that the sheet names should start with
    searchText = "PP"
   
    ' Set the path where the PDF will be saved
    savePath = ThisWorkbook.Path & "\SelectedSheets_PP.pdf"
   
    ' Loop through all sheets and collect the names of sheets starting with the search text
    i = 0
    For Each ws In ThisWorkbook.Sheets
        sheetName = ws.Name
        If Left(sheetName, Len(searchText)) = searchText Then
            ReDim Preserve wsArray(i)
            wsArray(i) = sheetName
            i = i + 1
        End If
    Next ws
   
    ' Check if any sheets were found
    If i > 0 Then
        ' Export the selected sheets as a single PDF
        ThisWorkbook.Sheets(wsArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, Quality:=xlQualityStandard
        MsgBox "PDF saved successfully at: " & savePath
    Else
        MsgBox "No sheets found starting with: " & searchText
    End If
End Sub

Thank you so much! This worked perfectly.