Variable Print Area Macro Based on Cell Value

I have a sheet of reference data (A1:I530), and I would like to create a macro that sets the print area for only rows that have a $ total in the H column, and a $ total in the I column. Stated another way, any row that is 0 in H or I columns wouldn't print. I only want this to apply to this individual sheet titled "Cost Codes".

I think this would be much more economical both for time and paper use than conditional formatting.

Does anyone have suggestions? Any help is greatly appreciated!


Thank you

Hello cuclay,

It can be done using VBA macros, if that is allowable in your case. Since the Print Area can only be set to a range of contiguous cells, it would require copying the selected data to another worksheet before it can be printed out. My guess would be some the formatting on the original sheet would need to copied over to the printout sheet. If you can post the workbook, that would be best. Change or remove any confidential or sensitive data beforehand.

Hello Clay,

The attached workbook has a button on the "Cost Codes" sheet to print out the non zero totals. Each row is added to the worksheet "Printout Data" to build the printable data in contiguous rows. You will probably need to adjust your margins on the "Printout Data" sheet. Let me know if this is what you want.

Sub PrintData()

  Dim Cell As Range
  Dim DstWks As Worksheet
  Dim NextRow As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SrcWks As Worksheet
  
    Set SrcWks = Worksheets("Cost Codes")
    Set DstWks = Worksheets("Printout Data")
    
      Set Rng = SrcWks.Range("B6")
      Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
      Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, SrcWks.Range(Rng, RngEnd))
      Set Rng = Rng.Resize(ColumnSize:=8)
      
      DstWks.UsedRange.Clear
      
        For Each Cell In Rng.Columns(7).Cells
          If Val(Cell.Value) > 0 Or Val(Cell.Offset(0, 1)) > 0 Then
             NextRow = NextRow + 1
             Rng.Rows(Cell.Row - Rng.Row + 1).Copy
             DstWks.Cells(NextRow, "A").PasteSpecial Paste:=xlPasteValues
             DstWks.Cells(NextRow, "A").PasteSpecial Paste:=xlPasteFormats
          End If
       Next Cell
       
     DstWks.UsedRange.Columns.AutoFit
     DstWks.PrintOut
     
End Sub

Hello Clay,

I can add the headings to the "Printout Data" sheet. Which ones do you want from the "Cost Codes"?

I'll remove the automatic print function for you. Did it print out okay?