Printing Sheets Based On Criteria VBA

I have following codes which prints the selected sheet within range in the workbook. Now, I want to be able to without deleting or disturbing the range, select the sheets which i want to print by marking them "x" in the next column. And other thing which i want to do is to be able to print some sheets from other workbook (as the workbook should be opened and selected sheet printed) but in same directory, if i specify the print range in the existing range of sheets which are to be printed.

Kindly advise.

Code:

---

Option Explicit
Sub Print_Ranges()
    Dim strShtname As String, strRngName As String
    Dim i As Long
 
    With Worksheets("INDEX")
 
        'sort the named range list according to page number order
        .Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom
 
        'loop through the cells and determine parent of named range and specific range addresses
        For i = 3 To 34
            strRngName = .Cells(i, 2).Text
            strShtname = Range(strRngName).Parent.Name
 
            'clear any existing print areas and reset to named ranges areas
            With Worksheets(strShtname)
                .PageSetup.PrintArea = ""
                .PageSetup.PrintArea = Range(strRngName).Address
                .PrintOut
            '  .PrintPreview
            End With
        Next i
    End With
 
End Sub

---

HI excel_learner,

Welcome to ExcelFox!!

Try this. Untested.

Code:

---

Option Explicit
Sub Print_Ranges()
    Dim strShtname As String, strRngName As String
    Dim i As Long
 
    With Worksheets("INDEX")
 
        'sort the named range list according to page number order
        .Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom
 
        'loop through the cells and determine parent of named range and specific range addresses
        For i = 3 To 34
            If LCase$(.Cells(i, "C").Text) = "x" Then 'I assume the 'X' is in Col C,if not, replace "C" with appropriate Col
              strRngName = .Cells(i, 2).Text
              strShtname = Range(strRngName).Parent.Name
   
              'clear any existing print areas and reset to named ranges areas
              With Worksheets(strShtname)
                  .PageSetup.PrintArea = ""
                  .PageSetup.PrintArea = Range(strRngName).Address
                  .PrintOut
              '  .PrintPreview
              End With
            End If
        Next i
    End With
 
End Sub

'//This routine is for print sheets from other workbook

Sub PrintRangesFromOtherWorbook(ByVal WbkName As String, ParamArray Sheets2Print() As Variant)
   
    'workbook name should be with the extension
   
    Dim i          As Long
    Dim wbkOther    As Workbook
   
    With Application
        .ScreenUpdating = 0
        .EnableEvents = 0
        .DisplayAlerts = 0
    End With
   
    On Error Resume Next
    Set wbkOther = Workbooks(CStr(WbkName))
    If Err.Number <> 0 Then
        Err.Clear
        Set wbkOther = Workbooks.Open(ThisWorkbook.Path & "\" & WbkName, 0)
        If Err.Number <> 0 Then
            MsgBox "Workbook '" & WbkName & "' not found in" & vbLf & ThisWorkbook.Path, vbInformation
            Err.Clear
            GoTo QuickExit
        End If
    End If
   
    For i = LBound(Sheets2Print) To UBound(Sheets2Print)
        'I hope print area is there in every sheet
        With wbkOther.Worksheets(Sheets2Print(i))
            .PrintOut
        '  .PrintPreview
        End With
        MsgBox Sheets2Print(i)
    Next
QuickExit:
    With Application
        .ScreenUpdating = 1
        .EnableEvents = 1
        .DisplayAlerts = 1
    End With
End Sub

'// Call the macro like..

Sub kTest()
    PrintRangesFromOtherWorbook "OtherWorkbookName.xls", "Sheet1", "Sheet2", "Sheet3"
End Sub

---

HTH