print macro to solve limit on page breaks

[Jim Palmer]

I have encountered the limit on the number of page breaks that exce
allows, and I'd like to write a macro to work around this.

My data is as follow:

Part Number Location Quantity
12345 12 10
12345 20 15
12346 35 37

The macro should begin in row 2
determine that there are two rows to be printed (for part numbe
12345)
print the range
move to the next part, determine how many rows to print

and so on until it reaches a blank row (or I could enter 99999 as th
stopping part number).

Any suggestions would be greatly appreciated.

Regards

Jim Palme

 

[Dave Peterson]

Maybe you can use an autofilter to cycle through all the unique values in column
A:

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myCell As Range
Dim myRng As Range

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=newWks.Range("A1"), Unique:=True
End With

With newWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With curWks
.AutoFilterMode = False
For Each myCell In myRng.Cells
.Range("a:a").AutoFilter field:=1, Criteria1:=myCell.Value
.PrintOut preview:=True
Next myCell
.AutoFilterMode = False
End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True

End Sub

 

[Jim Palmer]

Thanks very much Dave.

This is of great assistance.

I'd appreciate your assistance with some fine tuning.

First,
I suppose I just have to change the line "PrintOut preview:=True" t
false to prevent it from pausing at each page?

Second,
Each page is page one of one and I'd prefer the page numbers t
increment.
Could we add a variable for page number and then increment it by on
each time?

Third,
Could I add other criteria?
That is, only print if the variance is more than say $10?

Best Regards

Jim Palme

 

[Jim Palmer]

I've worked it out, here is the revised version

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myCell As Range
Dim myRng As Range

Dim Place_holder As Variant ' Added by JPalmer
Place_holder = 1 ' Added by JPalmer


Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=newWks.Range("A1"), Unique:=True
End With

With newWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With curWks
.AutoFilterMode = False
For Each myCell In myRng.Cells
.Range("a:a").AutoFilter Field:=1, Criteria1:=myCell.Value


If Range("VarianceTest").Value > 200 Then ' Added by JPalmer, onl
print if Variance over $200

GoSub Page_Number:
'.PrintOut preview:=True, commented out, paused at each page
curWks.PrintOut Copies:=1, Collate:=True
Place_holder = Place_holder + 1 ' added by JPalmer

End If


Next myCell
.AutoFilterMode = False
End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True

Exit Sub ' Changed to exit sub as end sub follows the page number su
routine

Page_Number:


With curWks.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
curWks.PageSetup.PrintArea = ""
With curWks.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&16&HPage number " & Place_holder ' added b
Jpalmer to increment page Number
.LeftFooter = "&8&H&D &T"
.CenterFooter = ""
.RightFooter = "&8&H&Z" & Chr(10) & "&F"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
Return

End Sub


How many macros do I have to write before my status changes fro
"junior"?

Dave

Are you the former premier of Ontario?

Take care

Ji

 

[Dave Peterson]

Glad you got it working. And you used GoSub. I don't think I've ever seen
anyone use that in a longggggggg time. <vbg>.

 

[Dave Peterson]

I think most people would just use a subroutine call or a function.

(And finding old code and making it work seems like a very reasonable approach
to me--thank goodness for google!)

For example:

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myCell As Range
Dim myRng As Range
Dim Place_holder As Long ' Added by JPalmer

Place_holder = 1 ' Added by JPalmer

Set curWks = Worksheets("sheet1")
With curWks
' Added by JPalmer, only print if Variance over $200
If .Range("VarianceTest").Value > 200 Then
'keep going
Else
MsgBox "Variance Test is not large enough!"
Exit Sub
End If

Set newWks = Worksheets.Add

.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=newWks.Range("A1"), Unique:=True
End With

With newWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With curWks
.AutoFilterMode = False
For Each myCell In myRng.Cells
.Range("a:a").AutoFilter Field:=1, Criteria1:=myCell.Value

Call Page_Number(curWks, Place_holder)

.PrintOut preview:=True 'used for testing only
'.PrintOut Copies:=1, Collate:=True
Place_holder = Place_holder + 1 ' added by JPalmer

Next myCell
.AutoFilterMode = False
End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True

End Sub

Sub Page_Number(curWks As Worksheet, Place_holder As Long)
With curWks.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&16&HPage number " & Place_holder
' added by Jpalmer to increment page Number
.LeftFooter = "&8&H&D &T"
.CenterFooter = ""
.RightFooter = "&8&H&Z" & Chr(10) & "&F"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub

The other thing you may want to do is to just set the page setup properties that
are changing. Each one of those changes (whether or not it's a real change,
will slow your procedure down).

Maybe the only thing you have to keep would be:

Sub Page_Number(curWks As Worksheet, Place_holder As Long)
With curWks.PageSetup
' added by Jpalmer to increment page Number
.RightHeader = "&16&HPage number " & Place_holder
End With
End Sub


==
I did move the check for the value in variancetest (on the same worksheet????)
higher in the code. It wouldn't have to be checked each time and there's no
reason to insert a new sheet if you won't be using it.

 

[Jim Palmer]

Thanks again for your assistance.

You're right, those page setup properties did slow the procedure down.

Actually the "variancetest" did have to be checked each time. I
contains the formula = subtotal(9,i2:i15000). That is, each page wit
a subtotal > 200 is printed.

Your idea of not inserting a sheet if I'm not using it makes sense
but the test would have to be against the grand total, not th
subtotal.

I should have documented what that range contained.

Jim Palme

 

[Dave Peterson]

Glad you got it working. And I now see why you checked it each time.