Print an Array to PDF only the tabs if Value in Cell is Greater than 0

[ExcelError]

Good morning,

I have a Print to PDF VBA that I've been using for years. It's quite simple. The tool prints the Print Areas I set in tabs to a PDF. It is a CTR / Invoice Workbook. There is an inconvenient step at the end of this requiring me to go into Adobe and delete all the Sheets with a $0 value in the specific CTR as it adds no value to be in the PDF. What I would like to do is upgrade this VBA to print ONLY the tabs to PDF on which the value of a cell (Example is Cell H2421), is Greater than 0.

Here is the VBA.

Sub PrintCTRBook()
'
' PrintCTRBook Macro
'

'
Sheets(Array("PNF Summary", "CTR Summary", "Software", "CTR1", "CTR2", "CTR3", "CTR4" _
, "CTR5", "CTR6", "CTR7", "CTR8", "CTR9", "CTR10", "CTR11", "CTR12", "CTR13", "CTR14", _
"CTR15", "CTR19", "CTR90", "CTR95", "CTR98", "CTR99")).Select
Sheets("PNF Summary").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

End Sub

 

[Jeffrey Mahoney]

Try something like this

Sub PrintCTRBook()

  Dim Sht As Worksheet
  Dim ShtNames() As String
  Dim X As Long
  
  ReDim ShtNames(1 To 100)
  
  For Each Sht In ThisWorkbook.Worksheets
    If Sht.Range("H2421") > 0 Then
      X = X + 1
      ShtNames(X) = Sht.Name
    End If
  Next Sht
  ReDim Preserve ShtNames(1 To X)
  
  Sheets(ShtNames()).Select
  Sheets("PNF Summary").Activate
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

 

[ExcelError]

This is close, but it needs to be only specific tabs that are checked to print if a Cell is Greater than 0 (which I have now linked universally on these tabs to R1). I know this is not correct, but something like this.

Sub PrintCTRBookTwo()

'
'

Sheets("CTR1").Activate


Dim Sht As Worksheets(Array("CTR1", "CTR2", "CTR3", "CTR4", "CTR5", "CTR6", "CTR7", "CTR8", "CTR9", "CTR10", "CTR11", "CTR12", "CTR13", "CTR14", "CTR15", "CTR19", "CTR90", "CTR95", "CTR98", "CTR99")).Select
Dim ShtNames() As String
Dim X As Long

ReDim ShtNames(1 To 100)

Dim ShtNames() As String
Dim X As Long

For Each Sht In ThisWorkbook.Worksheets
If Sht.Range("R1") > 0 Then
X = X + 1
ShtNames(X) = Sht.Name
End If
Next Sht
ReDim Preserve ShtNames(1 To X)


Sheets(Array("PNF Summary", "CTR Summary", "Software", ShtNames())).Select
Sheets("PNF Summary").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

 

[Tetra201]

See if the following sub works for you:

Sub PrintCTRBook()
    Dim t, s, a()
    Dim c As New Collection
    Dim i As Long
    t = Array("PNF Summary", "CTR Summary", "Software", "CTR1", "CTR2", "CTR3", _
        "CTR4", "CTR5", "CTR6", "CTR7", "CTR8", "CTR9", "CTR10", "CTR11", "CTR12", _
        "CTR13", "CTR14", "CTR15", "CTR19", "CTR90", "CTR95", "CTR98", "CTR99")
    For Each s In t
        If Sheets(s).[H2421] > 0 Then c.Add s
    Next s
    ReDim a(1 To c.Count)
    For i = 1 To c.Count
        a(i) = c.Item(i)
    Next i
    Sheets(a).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

 

[ExcelError]

This one Worked! Thank you very much! I appreciate it!