asked on

Select Multiple Worksheets Based Upon Cell Values

I need to have a macro that will select multiple sheets based upon the value of a range and then print the selected sheets.

Example:
There are four Sheets:

Sheet 1 will always be selected in this macro

Sheets 2-4 need to be selected if SUM of Range in each sheet (B8:B500) is > 0

Once all of the sheets are selected I need it to issue a print (ctrl-p).

My users will then complete the printing process manually.

sdwalker

This does what you need for Excel 2007 (it actually prints the sheets). Let me know if you have any questions.

Good luck,

sdwalker

Sub PrintSheets()

Dim myRange As Range

Application.ScreenUpdating = False

  Sheets("Sheet1").Select
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"

  For i = 2 To 4
    Sheets("Sheet" & i).Select
      Set myRange = Range("B8:B500")
    myVal = Application.WorksheetFunction.Sum(myRange)
    
    If myVal > 0 Then
      ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
    End If
  Next i


Application.ScreenUpdating = False

End Sub

Open in new window

Ardhendu Sarangi

can you try the following code?

see attached spreadsheet..

Sub printme()
    Dim iFlag As String
    Sheet2.Range("B501") = "=SUM(R[-493]C:R[-1]C)"
    Sheet3.Range("B501") = "=SUM(R[-493]C:R[-1]C)"
    Sheet4.Range("B501") = "=SUM(R[-493]C:R[-1]C)"
    If Sheet2.Range("B501") > 0 Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet2")).Select
        iFlag = "S2"
    End If
    If Sheet3.Range("B501") > 0 Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet3")).Select
        iFlag = "S3"
    End If
    If Sheet4.Range("B501") > 0 Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet4")).Select
        iFlag = "S4"
    End If
    If Sheet2.Range("B501") > 0 And Sheet3.Range("B501") Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
        iFlag = "S23"
    End If
    If Sheet2.Range("B501") > 0 And Sheet4.Range("B501") Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
        iFlag = "S24"
    End If
    If Sheet3.Range("B501") > 0 And Sheet4.Range("B501") Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet3", "Sheet4")).Select
        iFlag = "S34"
    End If
    If Sheet2.Range("B501") > 0 And Sheet3.Range("B501") > 0 And Sheet4.Range("B501") Then
        Sheet1.Select
        Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
        iFlag = "S234"
    End If
    Select Case iFlag
    Case "S2"
        MsgBox ("Sheets 1 and Sheets 2 Selected for Printing")
    Case "S3"
        MsgBox ("Sheets 1 and Sheets 3 Selected for Printing")
    Case "S4"
        MsgBox ("Sheets 1 and Sheets 4 Selected for Printing")
    Case "S23"
        MsgBox ("Sheets 1, Sheets 2 and Sheets 3 Selected for Printing")
    Case "S24"
        MsgBox ("Sheets 1, Sheets 2 and Sheets 4 Selected for Printing")
    Case "S34"
        MsgBox ("Sheets 1, Sheets 3 and Sheets 4 Selected for Printing")
    Case "S234"
        MsgBox ("Sheets 1, Sheets 2, Sheets 3 and Sheets 4 Selected for Printing")
    End Select
End Sub

Open in new window

Sheets.xlsm

byundt

The Sheet Select method allows you to append to the current selection if you like. This allows the code to be much shorter. The last statement displays the print dialog with the selected sheets being preselected, so the user can complete the printing operation.

Sub Printout1()
Worksheets("Sheet1").Select
If Application.Sum(Worksheets("Sheet2").Range("B8:B500")) > 0 Then Sheets("Sheet2").Select Replace:=False
If Application.Sum(Worksheets("Sheet3").Range("B8:B500")) > 0 Then Sheets("Sheet3").Select Replace:=False
If Application.Sum(Worksheets("Sheet4").Range("B8:B500")) > 0 Then Sheets("Sheet4").Select Replace:=False
Application.Dialogs(xlDialogPrint).Show Arg12:=True
End Sub

Open in new window

Brad

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

CraigNorthcutt

ASKER

Great work. Exactly what I needed. Simple, concise, effective.

Thanks!