print macro to solve limit on page breaks

I have encountered the limit on the number of page breaks that excel
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 number
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 the
stopping part number).

Any suggestions would be greatly appreciated.

Regards

Jim Palmer


---
Message posted from http://www.ExcelForum.com/

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 " wrote:

I have encountered the limit on the number of page breaks that excel
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 number
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 the
stopping part number).

Any suggestions would be greatly appreciated.

Regards

Jim Palmer

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

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" to
false to prevent it from pausing at each page?

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

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

Best Regards

Jim Palmer


---
Message posted from http://www.ExcelForum.com/

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, only
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 sub
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 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
Return

End Sub


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

Dave

Are you the former premier of Ontario?

Take care

Jim


---
Message posted from http://www.ExcelForum.com/

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.



"Jim Palmer " wrote:

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, only
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 sub
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 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
Return

End Sub

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

Dave

Are you the former premier of Ontario?

Take care

Jim

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Okay, what's the alternative to GoSub?

I'm an accountant, not a programmer, so I found some old code and made
it work.

I'd appreciate knowing an easier, or more efficient method.

Take care

Jim


---
Message posted from http://www.ExcelForum.com/

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 " wrote:

Okay, what's the alternative to GoSub?

I'm an accountant, not a programmer, so I found some old code and made
it work.

I'd appreciate knowing an easier, or more efficient method.

Take care

Jim

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

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. It
contains the formula = subtotal(9,i2:i15000). That is, each page with
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 the
subtotal.

I should have documented what that range contained.

Jim Palmer


---
Message posted from http://www.ExcelForum.com/

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

"Jim Palmer " wrote:

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. It
contains the formula = subtotal(9,i2:i15000). That is, each page with
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 the
subtotal.

I should have documented what that range contained.

Jim Palmer

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson