Variable Print Area Macro Based on Cell Value

**cuclay** · 10-26-2009, 06:16 PM

I've now posted the workbook. Could anyone help me with a macro that could sort the data on the 'Cost Codes' worksheet so that any rows with $0 in column I or H would be below those rows with $ totals in them. I would then print only the items that have $ totals, and leave the rows with zeros outside the print area. If I could then maintain the rest of the organization as close as possible after sorting, that would be helpful. May have to number the rows in cells in order to achieve this.

Please let me know if you have thoughts. I can't tell you how much the help would be appreciated.

Thanks again,

Clay

**Leith Ross** · 10-27-2009, 02:52 AM

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

**cuclay** · 10-27-2009, 11:30 AM

Leith -

This is amazing man! A couple questions for you:

- Is there a way to make the 'Print Out' sheet preserve column headings from 'Cost Codes' sheet when the button is clicked?
- Is there a way to remove the automatic print function? I only want to do so because we have a lot of networked printers, and my staff will need to manually print that sheet.

And finally, do you have any recommendations on how I can begin to learn about creating macros for myself? I have seen a few posts on here where people were taught quite a lot from stem to stern. I am pretty adept in Excel itself, but have very limited experience with VBA.

I honestly cannot tell you how much I appreciate your help. This is great.

Thank you again,

Clay

**Leith Ross** · 10-27-2009, 11:37 AM

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?

**Leith Ross** · 10-29-2009, 08:26 PM

Hello Clay,

I didn't forget about you. I have made the changes to the workbook as you requested. Here is the updated macro that has been added to the attached workbook.

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
  
    NextRow = 2
    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)
      
      With DstWks.UsedRange
        If .Rows.Count > 1 Then
           .Offset(1, 0).Resize(RowSize:=.Rows.Count - 1).Clear
        End If
      End With
      
      Application.ScreenUpdating = False
        For Each Cell In Rng.Columns(7).Cells
          If Val(Cell.Value) > 0 Or Val(Cell.Offset(0, 1)) > 0 Then
             Rng.Rows(Cell.Row - Rng.Row + 1).Copy
             DstWks.Cells(NextRow, "A").PasteSpecial Paste:=xlPasteValues
             DstWks.Cells(NextRow, "A").PasteSpecial Paste:=xlPasteFormats
             NextRow = NextRow + 1
          End If
       Next Cell
     Application.ScreenUpdating = True
     
     DstWks.PageSetup.CenterHeader = "&B" & Worksheets("Estimate Sheet").Range("I1")
     DstWks.UsedRange.Columns.AutoFit
     
End Sub