print multiple sheets based on user choices

[kublakhan]

I'm writing a macro that prints out certain ranges and certain worksheets in a workbook based on user choices. I'd like to make use of this code:

Sub PrintSheets()
Dim aShtLst As Variant
aShtLst = Array(?Sheet1″, ?Sheet2″, ?Sheet3″)
ThisWorkbook.Sheets(aShtLst).PrintOut
End Sub

My idea was to create cell that dynamically outputs ("Sheet1", "Sheet2", "Sheet3") and pass that value to the Array. The Array doesn't like that, however. Any suggestions?

[Bob Phillips]

Create a range with the sheet names in and use that

[vba]

Sub PrintSheets()
Dim aShtLst As Variant
aShtLst = Application.Transpose(Worksheets("Sheet1").Range("A1:A3"))
Worksheets(aShtLst).Select
ActiveWindow.SelectedSheets.PrintOut
End Sub
[/vba]

[kublakhan]

Follow-up question: that routine fails if, for example, the user doesn't want to print Sheet2 and therefore A2 is empty (or rather value = ""). Might there be a way to loop through the range and ignore empty cells? Or does that get back into the tricky Array territory?

[mdmackillop]

A slight variation. Put x in a range of cells to obtain the sheet name corresponding to the row number. I'm also having inconsistent results with printing from an array, but you can combine this with XLD's solution if that works for you.

[VBA]Option Explicit
Sub PrintX()
Dim Arr(), i As Long, cel As Range
ReDim Arr(Selection.Cells.Count)
i = -1
For Each cel In Selection
If UCase(cel) = "X" Then
i = i + 1
Arr(i) = Sheets(cel.Row).Name
End If
Next
ReDim Preserve Arr(i)
Sheets(Arr).PrintOut
End Sub
[/VBA]

[kublakhan]

I may be disclosing my inexperience here, but it seems like that routine uses the row number to refer to the sheets' names. That would seem to really hamper the flexibility of naming sheets. At any rate, let me restate what I'm shooting for:
--I have a workbook with 10+ sheets
--I'd like the user to be able to choose which sheets to print out (from 1 to 10+)
--I have a worksheet which dynamically displays the desired worksheets' names (obviously, these can be in single cells, or concatenated, or whatever)
I found another bit of code that looked promising, but I can't figure out how to incorporate an IF/THEN loop into it. Here it is:
[VBA]Sub PrintSheetsLoop()
Dim aShtLst() As String
Dim sh As Object
Dim lShCnt As Long

ReDim aShtLst(1 To ThisWorkbook.Sheets.Count)

For lShCnt = LBound(aShtLst) To UBound(aShtLst)
aShtLst(lShCnt) = ThisWorkbook.Sheets(lShCnt).Name
Next lShCnt

ThisWorkbook.Sheets(aShtLst).PrintOut

End Sub[/VBA]

[mdmackillop]

This use of x reads in the sheet name according to the sheet index. Names can be anything.

[kublakhan]

Got it. Works great. Nothing like a real file to clear things up.

[mdmackillop]

Personally I would create a simple userform with 10 checkboxes, captioned from the sheet names e.g.
[VBA]Private Sub UserForm_Initialize()
For i = 1 To 10
Controls("Checkbox" & i).Caption = Sheets(i).Name
Next
End Sub

[/VBA]
and run the print from a button.

[Bob Phillips]

Avec dialog sheet, sans useform

[vba]


Sub BrowseSheets()
Const nPerColumn As Long = 35 'number of items per column
Const nWidth As Long = 7 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetGoto" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton

Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iBooks).text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.OptionButtons
If cb.Value = xlOn Then
Worksheets(cb.Caption).PrintOut
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete

End With

End Sub
[/vba]

[mdmackillop]

Je suis perdu!

[kublakhan]

Whoa! I do like the userform idea. One clarification: when I run the code within my workbook it gives the "Subscript out of range" error and stops on this line: [VBA]Arr(i) = Sheets(cel.Row).Name[/VBA] Any ideas on what I'm doing wrong? My modified code looks like this: [VBA]Sub SetPrintSheets()

Dim Arr(), i As Long, cel As Range, Rng As Range
Set Rng = Range("PA_Sheets")
ReDim Arr(Rng.Cells.Count)
i = -1
For Each cel In Rng
If UCase(cel) = "X" Then
i = i + 1
Arr(i) = Sheets(cel.Row).Name
End If
Next
ReDim Preserve Arr(i)

End Sub[/VBA] "PA_Sheets" resolves to "P36:P41". Sorry to be such a newbie.

[Bob Phillips]

[vba]

Sub SetPrintSheets()

Dim Arr
Arr = Application.Transpose(Range("PA_Sheets"))

End Sub
[/vba]

[kublakhan]

mdmackillop's original code is based on a vertical range, as is mine. How does transposing that range help?

[mdmackillop]

When I run the code within my workbook it gives the "Subscript out of range" .

That code depends upon the row number in which X is entered. If you are not starting at Row 1, you need to change the code.

This should work for any location, (or orientation)
[VBA]
Sub SetPrintSheets()

Dim Arr(), i As Long, j As Long, k As Long, Rng As Range
Set Rng = Range("PA_Sheets")
j = Rng.Cells.Count
ReDim Arr(j)
k = -1
For i = 1 To j
If UCase(Rng(i)) = "X" Then
k = k + 1
Arr(k) = Sheets(i).Name
End If
Next
ReDim Preserve Arr(k)

End Sub

[/VBA]

[Bob Phillips]

mdmackillop's original code is based on a vertical range, as is mine. How does transposing that range help?

Try it and see

[kublakhan]

Thanks to you both! I really appreciate the help.

[Bob Phillips]

Je suis perdu!

C'est simple, une forme automatique. Il serait si j'employais des checkboxes

[mdmackillop]

C'est simple, une forme automatique. Il serait si j'employais des checkboxes

Danke!