Print Array

[zoom38]

Good afternoon all, I started working on an old file that I am trying to modify the print routine. A while back one of the masters helped me with a print array sub that would count the sheets and send them to print preview and it works well. This was predicated on predetermined sheets that would print out. Please see the attachment, module 11, "PrintFullIAP".

On the attachment on the "Print IAP" tab you will see a box to mark specifically which pages the user wishes to print. I am having difficulty figuring out how to capture which page(s) to print without doing lengthy nested if statements in the "PrintSelectedIAP" sub.
I'm thinking that it is an easy modification but I can't come up with it so that's why I'm turning to you guys & gals for help.

I've slimmed down my file and attached it for ease of explanation. Once you see it, it should become more clear of what I am asking.

Thanks in advance.
Gary

[Paul_Hossler]

I'd do something like this




Sub PrintSelectedIAP()
Dim ppWorksheets() As String
Dim count204 As Long, i As Long

Application.ScreenUpdating = False
Application.EnableEvents = False


'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29
'page name is in row 10
count204 = -1
For i = 13 To 29
If Len(ActiveSheet.Cells(11, i).Value) > 0 Then
count204 = count204 + 1
ReDim Preserve ppWorksheets(count204)
ppWorksheets(UBound(ppWorksheets)) = ActiveSheet.Cells(10, i).Value
End If
Next i
Sheets(ppWorksheets).PrintPreview
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[zoom38]

Thanks for the reply Paul, but for some reason I'm getting a "Subscript out of range" error on the Sheets(ppWorksheets).PrintPreview line.
Do you have any thoughts on that?

Also a little clarification on what I was looking for. Your code got me to count the sheets that are selected but now I need to incorporate the code to count multiple sheets with the same name, ex: 204(1), 204(2), etc.
So the code below would need to be included in your code:


For Each ws In ThisWorkbook.Worksheets
If StrComp(Left(ws.Name, 3), "204", vbTextCompare) = 0 Then
count204 = count204 + 1
ReDim Preserve ppWorksheets(count204)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next ws

Unfortunately I can't get it to work. My main stumbling block right now is the subscript out of range error. This is what I have so far:


countsheets = -1


For i = 13 To 29
If Len(ActiveSheet.Cells(11, i).Value) > 0 Then
countsheets = countsheets + 1
ReDim Preserve ppWorksheets(countsheets)
ppWorksheets(UBound(ppWorksheets)) = ActiveSheet.Cells(10, i).Value
If ActiveSheet.Cells(10, i).Value = "204" Then
For Each ws In ThisWorkbook.Worksheets
If StrComp(Left(ws.Name, 3), "204", vbTextCompare) = 0 Then
countsheets = countsheets + 1
'count204 = count204 + 1
ReDim Preserve ppWorksheets(countsheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next ws
End If
End If
Next i
sheets(ppWorksheets).PrintPreview


Gary

[Paul_Hossler]

Sorry, but I'm not understanding

Are you saying that if there is an "X" in R11 under the "205" then you want to print all sheets with a name that that start with "205", "205(1)", "205(2)", "205(anything)" ?

Since the name of the appropriate sheet is in row 10 above the X in row 11, it was easy to just use that name.

Let me know

[zoom38]

Yes that is correct. Tough to show you with the 1mb attachment limitation. This code

For Each ws In ThisWorkbook.Worksheets
If StrComp(Left(ws.Name, 3), "204", vbTextCompare) = 0 Then
count204 = count204 + 1
ReDim Preserve ppWorksheets(count204)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next ws
does that for the 204 worksheets but for predefined worksheets. If you look in module 11 and look at the PrintFullIAP sub you will see how that works. I'd like to merge that code with whatever code that will grab the name of the appropriate sheets with the "X" in row 11 and if there is an "X" in R11 under the "205" then print all sheets with a name that that start with "205", "205(1)", "205(2)", "205(anything)".

My code above seem to work (I get the correct number of sheets in the variable countsheets) except I still get that "Subscript out of range" error on the
sheets(ppWorksheets).PrintPreview line.

[mperrah]

This was from a project I wanted to fill out a form from a list of data,
then print the form each time I filled it.
I put a check in the Column A for the rows to be filled into the form.
I've attached the doc for reference. 13128
Hope this helps.

Sub PrintUsingDatabase()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myAddresses As Variant
Dim lOrders As Long

Set FormWks = Worksheets("Routesheet")
Set DataWks = Worksheets("Techs")

'checked boxes on the tech sheet will fill the following cells on the route sheet
myAddresses = Array("A3", "A5", "D5", "F5", "D3")
'they will be fed into the cells above in the order shown
'they will be derived from each row with a check mark
'read into the arrar from left to right.

With DataWks
'first row of data to last row of data in column B
Set myRng = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each myCell In myRng.Cells
With myCell
If IsEmpty(.Offset(0, -1)) Then
'if the row is not marked, do nothing
ElseIf myCell.Offset(0, -1).Value = "a" Then
'.Offset(0, -1).ClearContents 'clear mark for the next time, i leave it marked so I know what printed
For iCtr = LBound(myAddresses) To UBound(myAddresses)
FormWks.Range(myAddresses(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate 'just in case
'after testing, change to Preview to False to Print
FormWks.PrintOut 'Preview:=True ' if you avoid the preview all the pages will print at once
lOrders = lOrders + 1
End If
End With
Next myCell

' MsgBox lOrders & " orders were printed." ' this can give you a count after its done

End Sub

[zoom38]

I'm having difficulty converting this to work with worksheets. Is it possible to advise what is wrong with the following code?


For i = 13 To 29
If Len(Cells(11, i).Value) > 0 Then
countsheets = countsheets + 1
ReDim Preserve ppWorksheets(countsheets)
ppWorksheets(UBound(ppWorksheets)) = Cells(10, i).Text 'Value
End If
Next i
sheets(ppWorksheets).PrintPreview

it fails on the last line (Subscript out of range).

Thanks
Gary

[mperrah]

maybe pull from this.
I have a form on one sheet that gets data filled into it from a multiple rows of data, then a copy is added to after last sheet.


Sub AddToArchive()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim ws As Worksheet
Dim newSheetName As String
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myAddresses As Variant
Set FormWks = Worksheets("QCForm")
Set DataWks = Worksheets("Data")

With Application
.Calculate
.ScreenUpdating = False
.Calculation = xlCalculationManual

End With

myAddresses = Array("A2", "B5", "D12", "D8", "D6", "D7", "F11", "D10", "B4", "B11", "B12", "F12", "B10", "F4", "E44", "F44", "F16", "F17", "F18", "F19", "F20", "F21", "F22", "F24", "F25", "F26", "F27", "F28", "F29", "F30", "F31", "F32", "F33", "F35", "F36", "F37", "F38", "F39", "F40", "F41", "F42", "F43", "B46", "B8", "F5", "B6", "B51", "E51")

With DataWks
Set myRng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With
For Each myCell In myRng.Cells
With myCell
If IsEmpty(.Offset(0, -1)) Then

ElseIf myCell.Offset(0, -1).Value = "a" Then

For iCtr = LBound(myAddresses) To UBound(myAddresses)
FormWks.Range(myAddresses(iCtr)).Value = myCell.Offset(0, iCtr).Value
Next iCtr

newSheetName = FormWks.Range("D10")

checking_again:
For Each ws In Worksheets
If ws.Name = newSheetName Or newSheetName = "" Or IsNumeric(newSheetName) Then
Beep
newSheetName = InputBox("Duplicate(s) found no jobs sent, uncheck jobs " & _
"previously archived or give new name ...", "Sheets conflict found", ws.Name)
If newSheetName = vbNullString Then
Exit Sub
End If
GoTo checking_again
End If
Next ws

FormWks.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = newSheetName

End If
End With
Next myCell

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Then this is a slight modification to just print each as its filled in instead of copying.

Sub PrintQCForm()
Dim FormWks As Worksheet
Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myAddresses As Variant

Set FormWks = Worksheets("QCForm")
Set DataWks = Worksheets("Data")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

myAddresses = Array("A2", "B5", "D12", "D8", "D6", "D7", "F11", "D10", "B4", "B11", "B12", "F12", "B10", "F4", "E44", "F44", "F16", "F17", "F18", "F19", "F20", "F21", "F22", "F24", "F25", "F26", "F27", "F28", "F29", "F30", "F31", "F32", "F33", "F35", "F36", "F37", "F38", "F39", "F40", "F41", "F42", "F43", "B46", "B8", "F5", "B6", "B51", "E51")

With DataWks
Set myRng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each myCell In myRng.Cells
With myCell
If IsEmpty(.Offset(0, -1)) Then

ElseIf myCell.Offset(0, -1).Value = "a" Then
For iCtr = LBound(myAddresses) To UBound(myAddresses)
FormWks.Range(myAddresses(iCtr)).Value _
= myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate '
FormWks.PrintOut
End If
End With
Next myCell

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[Paul_Hossler]

@zoom38 -- try something like this

The attachment just has some blank sheets and the macro in it





Sub PrintSelectedIAP_1()
Dim ppWorksheets() As String
Dim iCountSheets As Long, i As Long
Dim ws As Worksheet
Dim sPrefix As String
Application.ScreenUpdating = False
Application.EnableEvents = False


'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29
'page name is in row 10
iCountSheets = -1
For i = 13 To 29
If Len(ActiveSheet.Cells(11, i).Value) > 0 Then

sPrefix = ActiveSheet.Cells(10, i).Value

For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next i
' Sheets(ppWorksheets).PrintPreview
'for test
For iCountSheets = LBound(ppWorksheets) To UBound(ppWorksheets)
MsgBox ppWorksheets(iCountSheets)
Next

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[zoom38]

Paul it works perfectly. Thanks for the help.
Thanks to all who took the time to give it a try.
Solved.

Gary

[zoom38]

Thank you again Paul, I modified the code to include specific ranges like this.


Set myrange1 = Range("M11:AC11")
Set myrange2 = Range("M15:X15")
Set myrange3 = Range("Z15")
Set myrange4 = Range("N19")
Set myrange5 = Range("Z19")

'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29, page name is in row 10
iCountSheets = -1
For Each cell In myrange1
If Not IsEmpty(cell) Then
sPrefix = cell.Offset(-1, 0).Value
If sPrefix = "Cover" Then
sPrefix = "IAP Cover"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next
' sheets(ppWorksheets).PrintPreview
For Each cell In myrange2
If Not IsEmpty(cell) Then
sPrefix = cell.Offset(-1, 0).Value
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

For Each cell In myrange3
If Not IsEmpty(cell) Then
sPrefix = cell.Offset(0, 1).Value
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

However if I combine the ranges like


Set myrange1 = Range("M11:AC11","M15:X15")

and only use one "For/Next" loop of the code it goes into and infinite loop. What causes this? Is there a way to combine the ranges and not send it into an infinite loop?
Thanks
Gary

[Paul_Hossler]

I'll look, but post a copy of JUST the final code that looks to make sure that we're on the same page

The other thing would be to just step through the code and follow what's happening

[zoom38]

Ive tried stepping thru the code and am not understanding the issue. When I combine the ranges the code just keeps running thru and doesnt stop.


Dim myrange1 As Range
Dim myrange4 As Range

Set myrange1 = Range("M11:AC11", "M15:X15")
Set myrange4 = Range("Z15")

'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29, page name is in row 10
iCountSheets = -1
For Each cell In myrange1
If Not IsEmpty(cell) Then
sPrefix = cell.Offset(-1, 0).Value
If sPrefix = "Cover" Then
sPrefix = "IAP Cover"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

ws = "Nothing" and I get the following message when I hover over anything to do with the other lines relating to ws. "<Object variable or With Block variable not set>". I'm not sure why?

[Paul_Hossler]

Sub PrintSelectedIAP_2()
Dim ppWorksheets() As String
Dim iCountSheets As Long, i As Long
'1. don't rely on activesheet -- so I like to set it
Dim ws As Worksheet, wsPrint As Worksheet

Dim sPrefix As String
Dim myRange1 As Range
Dim myRange4 As Range

'2. cell is too 'Excel-like' I wouldn't use it as a variable name
Dim myCell As Range

Set wsPrint = ActiveWorkbook.Worksheets("Print IAP")

'3. the UNION of the two ranges was not correctly specified -- use a comma
Set myRange1 = wsPrint.Range("M11:AC11,M15:X15")
Set myRange4 = wsPrint.Range("Z15")

'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29, page name is in row 10
iCountSheets = -1
For Each myCell In myRange1

' Debug.Print mycell.Address(1, 1, 1, 1)
If Not IsEmpty(myCell) Then
sPrefix = myCell.Offset(-1, 0).Value
If sPrefix = "Cover" Then sPrefix = "IAP Cover"
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

MsgBox "Done -- Click [OK] and then Check Watch Window at the {Stop}"
Stop

End Sub

[Paul_Hossler]

And sample XLSM with few sheets that I tested with




ws = "Nothing" and I get the following message when I hover over anything to do with the other lines relating to ws. "<Object variable or With Block variable not set>". I'm not sure why?


I didn't see all of your module, but IIRC you didn't use Option Explicit. Did you Dim ws As Worksheet?

[zoom38]

Paul, I agree I shouldn't use cell as a reference so I changed it to mycell. Yes, I did DIM ws as Worksheet. It turns out that my problem was the way i put the ranges together. Thank you for pointing that out, I was banging my head against the wall. Sometimes I rely on Excel too much to point out my coding mistakes and it didn't pick this one up. So here is my final coding with your help.



Sub PrintSelectedIAP()

Dim ppWorksheets() As String
Dim iCountSheets As Long, i As Long
Dim ws As Worksheet
Dim sPrefix As String

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim myrange1 As Range
Dim myrange4 As Range
Dim mycell As Range

Set myrange1 = Range("M11:AC11,M15:X15")
Set myrange2 = Range("Z15,N19,Q19,T19,W19,Z19")

'selection x is in merged cells !!! - Row 11, Col M - AC, or 13 - 29, page name is in row 10
iCountSheets = -1
For Each mycell In myrange1
If Not IsEmpty(mycell) Then
sPrefix = mycell.Offset(-1, 0).Value
If sPrefix = "Cover" Then
sPrefix = "IAP Cover"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

For Each mycell In myrange2
If Not IsEmpty(mycell) Then
sPrefix = mycell.Offset(0, 1).Value
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible And UCase(Left(ws.Name, Len(sPrefix))) = UCase(sPrefix) Then
iCountSheets = iCountSheets + 1
ReDim Preserve ppWorksheets(iCountSheets)
ppWorksheets(UBound(ppWorksheets)) = ws.Name
End If
Next
End If
Next

sheets(ppWorksheets).PrintPreview
'to test, rem line above and use next 3 lines
'For iCountSheets = LBound(ppWorksheets) To UBound(ppWorksheets)
' MsgBox ppWorksheets(iCountSheets)
'Next

Application.ScreenUpdating = True
Application.EnableEvents = True
sheets("Main Menu").Select
End Sub

Thank you very much, it works great.

Gary

[Paul_Hossler]

Glad you got it working

Few unsolicited comments




Dim myrange1 As Range
Dim myrange4 As Range
Dim mycell As Range

Set myrange1 = Range("M11:AC11,M15:X15")
Set myrange2 = Range("Z15,N19,Q19,T19,W19,Z19")


1. You Dim myrange4, but you use myrange2. If you add Option Explicit at the top of the module, it will force you to declare all variables. Sometimes it can be a pain, but it would alert you to the possible typo

2. You could probably simplify a little if you wanted to by trying this



Set myrange1 = Range("M11:AC11,M15:X15,Z15,N19,Q19,T19,W19,Z19")

[zoom38]

Thanks Paul, my declarations have been corrected. I will consider using Option Explicit but it has created headaches for me in the past. I didn't combine myrange1 & myrange2 because they have different cell offsets.

Thanks again for all your help.
Gary