Printing Macro

P

PhilosophersSage

Form Print Macro

I was given a workbook in which Sheets 1-4 are forms and have formulas
referring to sheet 5 which contains the data. I had to update the forms for a
new FY format and now the macro crashes XL.

Sub Printer()
'
' Printer Macro
' Keyboard Shortcut: Ctrl+p
'
Sheets("ATTACHMENT A").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
..
..
..
Sheets("ATTACHMENT B").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

The macro continues through the rest of the forms and rows

I want to optimize the code so it collates the forms together and if
possible send one print job to printer so I can use printer binging
functions. Also would like to do a test for last row in data so I don’t have
to hardcode lines(but don’t know how to achieve) Here is what I have but
cannot figure out where to go from here… Please help

Sub Printer()

Dim org(3) As Integer 'starting row 3 for print
Dim nxt As Integer 'next row to print
Dim Count As Integer 'Counter

Application.ScreenUpdating = False

For Count = 1 To 34 ‘need to change to test for last row
nxt = org + 1
Sheets("SHEET1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET2").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET4").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
org = org + 1
Next Count

‘need to reset back to 3

Application.ScreenUpdating = True


End Sub
 
M

Matthew Herbert

PhilosophersSage,

Stating that the macro crashes is one thing, stating where it crashes within
your code is another thing. Where are you experiencing the error, and what
does "update for a new FY format" mean?

I've put some code below for you to examine. The code is NOT tested.
Testing can ocurr via Step Into (Debug | Step Into) or F8 repeatedly.
Additionally, you can add Debug.Print into your code, which will print a
value to the Immediate Window (View | Immediate Window), e.g. "Print.Debug
varArrWks(intCntOne)" will print the value contained in the specified array
element (see the first section code below).

Again, none of the code below has been tested.

Best,

Matthew Herbert

First Section of your code

Dim varArrWks As Variant
Dim intArrReplace(1) As Integer
Dim intValue As Integer
Dim intCntOne As Integer
Dim intCntTwo As Integer

varArrWks = Array("ATTACHMENT A", "ATTACHMENT B")
intArrReplace(0) = 3
intArrReplace(1) = 4

For intCntOne = LBound(varArrWks) To UBound(varArrWks)
Print.Debug varArrWks(intCntOne)
Sheets(varArrWks(intCntOne)).Select
For intCntTwo = LBound(intArrReplace) To UBound(intArrReplace)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
intValue = intArrReplace(intCntTwo)
Cells.Replace What:=intValue, Replacement:=intValue + 1, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next intCntTwo
Next intCntOne

Second section of your code
Note: "Dim org(3) As Integer" is actually an array (i.e. simply put, a
single variable that holds multiple "values") of integer type. If option
base is 0, this array holds 4 elements (0, 1, 2, and 3). If option base is
1, this array holds 3 elements (1, 2, and 3). So, your "nxt = org + 1" is
trying to add a number to an array that contains 3 or 4 elements. Thus, the
compiler can't resolve adding an entire array by 1.

The code below is "guess" work on my part, so you'll need to test the code
and alter it as necessary.

Dim lngRowStart As Long
Dim lngRowNext As Long
Dim lngRowLast As Long
Dim lngCnt As Long
Dim intCnt As Integer
Dim varArrWks As Variant

Application.ScreenUpdating = False

'this is the very last cell in the worksheet
'you may need to alter this code, e.g.
' lngRowLast = Range("A" & Rows.Count).End(xlUp).Row
' will give you the last cell in column A
lngRowLast = ActiveSheet.Cells.Find(What:="*", _
After:=ActiveSheet.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lngRowStart = 3
varArrWks = Array("SHEET1", "SHEET2", "SHEET3", "SHEET4"))
For intCnt = LBound(varArrWks) To UBound(varArrWks)
Sheets(varArrWks(intCnt)).Select
For lngCnt = lngRowStart To lngRowLast
lngRowNext = lngCnt + 1
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=lngCnt, Replacement:=lngRowNext, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'I'm not sure what you are trying to do will this line:
' org = org + 1
Next lngCnt
Next intCnt
 
P

PhilosophersSage

Matthew,
Thank you so much for your help, and explinations! I tried the Print .Debug;
varArrWks(intCnt) but get a compile error "Method Not Valid without suitable
object" What am I doing wrong? Thank you!

Sub Printer()
'
' Printer Macro
' Keyboard Shortcut: Ctrl+p
'

Dim lngRowStart As Long
Dim lngRowNext As Long
Dim lngRowLast As Long
Dim lngCnt As Long
Dim intCnt As Integer
Dim varArrWks As Variant

Application.ScreenUpdating = False

'this is the very last cell in the worksheet
'you may need to alter this code, e.g.
lngRowLast = Range("B" & Rows.Count).End(xlUp).Row
' will give you the last cell in column B
lngRowLast = ActiveSheet.Cells.Find(What:="*", _
After:=ActiveSheet.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lngRowStart = 3
varArrWks = Array("LCAC DATA VALIDATION SHEET", "ATTACHMENT A", "ATTACHMENT
B", "ATTACHMENT C")
'For intCnt = LBound(varArrWks) To UBound(varArrWks)
'Sheets(varArrWks(intCnt)).Select
For lngCnt = lngRowStart To lngRowLast
lngRowNext = lngCnt + 1
For intCnt = LBound(varArrWks) To UBound(varArrWks)
Print .Debug; varArrWks(intCnt) 'Compile error
Sheets(varArrWks(intCnt)).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=lngCnt, Replacement:=lngRowNext, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'I'm not sure what you are trying to do will this line:
' org = org + 1
'Next lngCnt
Next intCnt
Next lngCnt
lngRowNext = 3
For intCnt = LBound(varArrWks) To UBound(varArrWks)
Sheets(varArrWks(intCnt)).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=lngCnt, Replacement:=lngRowNext, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Application.ScreenUpdating = True
Next intCnt

End Sub
 
M

Matthew Herbert

PhilosophersSage,

I almost typed everything correctly. I stated the syntax correctly in the
paragraph leading up to the example, but not in the example itself. It's not
"Print .Debug", but "Debug.Print". So, it should look like the following:

Debug.Print; varArrWks(intCnt)

Best,

Matt
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top