Ayansane
asked on
I get this error ['1004' Method Range' of Object _Worksheet' Failed] when try to run
Hi All,
I need to print tables from ranges where the SubTotal is not equal to zero. In specific cells.
I get a Run-Time Error ['1004' Method Range' of Object _Worksheet' Failed ] when I try running the code below.
It was working ok, but I needed to add a portion in blue to reference the right Print Areas...
Any help welcome as I'm feverishly working on this file. Thank you, thank you.
/code
Sub PrintCDivSum() 'von saerdna
Dim SaveActivePrinter As String
Dim DictC As Object 'Scripting.Dictionary
Dim DictP As Object 'Scripting.Dictionary
Dim SheetName As Variant, ThisSheet As Worksheet, ThisRange As Range
Dim SheetsToPrint As Variant, i As Long
SaveActivePrinter = Application.ActivePrinter
Select Case MsgBox("Print to " & SaveActivePrinter & "?", vbYesNoCancel, "PrintCDivSum")
Case vbYes
'Okay
Case vbNo
'Choose a printer
If Not Application.Dialogs(xlDial ogPrinterS etup).Show Then Exit Sub
Case vbCancel
'Abort
Exit Sub
End Select
Set DictC = CreateObject("Scripting.Di ctionary")
DictC.CompareMode = vbTextCompare
' SheetName, Cells for zero check
DictC.Add "GC's", "AI65,AI166"
DictC.Add "DIV 2", "AN65,AN166,AN268,AN370,AN 472,AN778, AN880,AN98 2,AN1084"
DictC.Add "DIV 3", "AN65,AN166,AN268,AN370,AN 472,AN778, AN880,AN98 2,AN1084"
DictC.Add "DIV 4", "AN65,AN166,AN268,AN370,AN 472"
DictC.Add "DIV 5", "AN65,AN166"
DictC.Add "DIV 6", "AN65,AN166"
DictC.Add "DIV 7", "AN65,AN166,AN268,AN370,AN 472,AG5:AP 65,AG5:AP4 72,AG205:A P268"
DictC.Add "DIV 8", "AN65,AN166"
DictC.Add "DIV 9", "AN65,AN166,AN268,AN370,AN 472,AN778"
DictC.Add "DIV 10", "AN65,AN166"
DictC.Add "DIV 14", "AN65"
DictC.Add "DIV 15", "AN65,AN166,AN268"
DictC.Add "DIV 16", "AN65"
Set DictP = CreateObject("Scripting.Di ctionary")
DictP.CompareMode = vbTextCompare
' SheetName, PrintArea
DictP.Add "GC's", "11a,12a"
DictP.Add "DIV 2", "13a,14a,15a,16a,17a,18a,1 9a,110a,11 1a,112a,11 3a"
DictP.Add "DIV 3", "l14a,l15a,l16a,l17a,l18a" '_SHT14,_SHT15,_SHT16,_SHT 17,_SHT18"
DictP.Add "DIV 4", "l19A" '_SHT19"
DictP.Add "DIV 5", "l20a,l21a" '_SHT20,_SHT21"
DictP.Add "DIV 6", "l22a,l23a" '_SHT22,_SHT23"
DictP.Add "DIV 7", "l24a,l25a,l26a,l27a,l28a" '_SHT24,_SHT25,_SHT26,_SHT 27,_SHT28"
DictP.Add "DIV 8", "l29a,l30a" '_SHT29,_SHT30"
DictP.Add "DIV 9", "l31a,l32a,l33a,l34a,l35a, l36a" '_SHT31,_SHT32,_SHT33,_SHT 34,_SHT35, _SHT36"
DictP.Add "DIV 10", "l37a,l38a" '_SHT37,_SHT38"
DictP.Add "DIV 14", "l39A" '_SHT39"
DictP.Add "DIV 15", "l40A,l41a,l42a" '_SHT40,_SHT41,_SHT42"
DictP.Add "DIV 16", "l43A" '_SHT43"
ReDim SheetsToPrint(1 To Sheets.Count)
'Each key in the dictionary is a sheet name
For Each SheetName In DictC.Keys
'Refer to the sheet
Set ThisSheet = Worksheets(SheetName)
With ThisSheet
'Refer to the cells
Set ThisRange = .Range(DictC.Item(SheetNam e))
'Skip if zero
If WorksheetFunction.Sum(This Range) <> 0 Then
'Add to print queue
i = i + 1
SheetsToPrint(i) = SheetName
'Set print area if any
If DictP.Exists(SheetName) Then
Set ThisRange = .Range(DictP.Item(SheetNam e))
.PageSetup.PrintArea = ThisRange.Address
End If
End If
End With
Next
'Print if necessary
If i > 0 Then
ReDim Preserve SheetsToPrint(1 To i)
Set ThisSheet = ActiveSheet
Sheets(SheetsToPrint).Sele ct
ActiveWindow.SelectedSheet s.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ThisSheet.Select
End If
Application.ActivePrinter = SaveActivePrinter
End Sub
/code
I need to print tables from ranges where the SubTotal is not equal to zero. In specific cells.
I get a Run-Time Error ['1004' Method Range' of Object _Worksheet' Failed ] when I try running the code below.
It was working ok, but I needed to add a portion in blue to reference the right Print Areas...
Any help welcome as I'm feverishly working on this file. Thank you, thank you.
/code
Sub PrintCDivSum() 'von saerdna
Dim SaveActivePrinter As String
Dim DictC As Object 'Scripting.Dictionary
Dim DictP As Object 'Scripting.Dictionary
Dim SheetName As Variant, ThisSheet As Worksheet, ThisRange As Range
Dim SheetsToPrint As Variant, i As Long
SaveActivePrinter = Application.ActivePrinter
Select Case MsgBox("Print to " & SaveActivePrinter & "?", vbYesNoCancel, "PrintCDivSum")
Case vbYes
'Okay
Case vbNo
'Choose a printer
If Not Application.Dialogs(xlDial
Case vbCancel
'Abort
Exit Sub
End Select
Set DictC = CreateObject("Scripting.Di
DictC.CompareMode = vbTextCompare
' SheetName, Cells for zero check
DictC.Add "GC's", "AI65,AI166"
DictC.Add "DIV 2", "AN65,AN166,AN268,AN370,AN
DictC.Add "DIV 3", "AN65,AN166,AN268,AN370,AN
DictC.Add "DIV 4", "AN65,AN166,AN268,AN370,AN
DictC.Add "DIV 5", "AN65,AN166"
DictC.Add "DIV 6", "AN65,AN166"
DictC.Add "DIV 7", "AN65,AN166,AN268,AN370,AN
DictC.Add "DIV 8", "AN65,AN166"
DictC.Add "DIV 9", "AN65,AN166,AN268,AN370,AN
DictC.Add "DIV 10", "AN65,AN166"
DictC.Add "DIV 14", "AN65"
DictC.Add "DIV 15", "AN65,AN166,AN268"
DictC.Add "DIV 16", "AN65"
Set DictP = CreateObject("Scripting.Di
DictP.CompareMode = vbTextCompare
' SheetName, PrintArea
DictP.Add "GC's", "11a,12a"
DictP.Add "DIV 2", "13a,14a,15a,16a,17a,18a,1
DictP.Add "DIV 3", "l14a,l15a,l16a,l17a,l18a"
DictP.Add "DIV 4", "l19A" '_SHT19"
DictP.Add "DIV 5", "l20a,l21a" '_SHT20,_SHT21"
DictP.Add "DIV 6", "l22a,l23a" '_SHT22,_SHT23"
DictP.Add "DIV 7", "l24a,l25a,l26a,l27a,l28a"
DictP.Add "DIV 8", "l29a,l30a" '_SHT29,_SHT30"
DictP.Add "DIV 9", "l31a,l32a,l33a,l34a,l35a,
DictP.Add "DIV 10", "l37a,l38a" '_SHT37,_SHT38"
DictP.Add "DIV 14", "l39A" '_SHT39"
DictP.Add "DIV 15", "l40A,l41a,l42a" '_SHT40,_SHT41,_SHT42"
DictP.Add "DIV 16", "l43A" '_SHT43"
ReDim SheetsToPrint(1 To Sheets.Count)
'Each key in the dictionary is a sheet name
For Each SheetName In DictC.Keys
'Refer to the sheet
Set ThisSheet = Worksheets(SheetName)
With ThisSheet
'Refer to the cells
Set ThisRange = .Range(DictC.Item(SheetNam
'Skip if zero
If WorksheetFunction.Sum(This
'Add to print queue
i = i + 1
SheetsToPrint(i) = SheetName
'Set print area if any
If DictP.Exists(SheetName) Then
Set ThisRange = .Range(DictP.Item(SheetNam
.PageSetup.PrintArea = ThisRange.Address
End If
End If
End With
Next
'Print if necessary
If i > 0 Then
ReDim Preserve SheetsToPrint(1 To i)
Set ThisSheet = ActiveSheet
Sheets(SheetsToPrint).Sele
ActiveWindow.SelectedSheet
ThisSheet.Select
End If
Application.ActivePrinter = SaveActivePrinter
End Sub
/code
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hey Roy_Cox,
So after the "error", the sheet name is "DIV 2"....
It still stops right there..
So after the "error", the sheet name is "DIV 2"....
It still stops right there..
ASKER
Yes... it does.. Please help.. Thx
Can you attach the workbook
ASKER
The file is too big to be uploaded.. Can I Dropbox it to you.. Or could you send me a DropBox upload link.? Thx
ASKER
I can also email to you.. I'm at ArbeitWali<at>Gmail<.>Com
ASKER
This link may work....: https://drive.google.com/file/d/0B_C9CGARkEdaZW1HNzd2bzZteVk/view?usp=sharing
Please let me know..
Please let me know..
This line is wrong
Where are you defining the keys for the dictionary?
Set ThisRange = .Range(DictP.Item(SheetName))
Where are you defining the keys for the dictionary?
ASKER
I'm defining the keys for the dictionary in the first section...then setting Print Areas in the second...to run the test then "not to print" those "Print Areas" where SubTotals are zeroes..
Is this correct?
'Set print area if any
If DictP.Exists(SheetName) Then
Set ThisRange = ThisRange
.PageSetup.PrintArea = ThisRange.Address
End If
ASKER
Ok, I get it..
So this is what I have..and, to your point, its correct:
'Set print area if any
If DictP.Exists(SheetName) Then
Set ThisRange = .Range(DictP.Item(SheetNam e))
.PageSetup.PrintArea = ThisRange.Address
End If
So this is what I have..and, to your point, its correct:
'Set print area if any
If DictP.Exists(SheetName) Then
Set ThisRange = .Range(DictP.Item(SheetNam
.PageSetup.PrintArea = ThisRange.Address
End If
ASKER
I really appreciate your help. Thx
Is it working now?
ASKER
I have not tried it.. Did not know you wanted me to try this code.. Let me check..
ASKER
I just tried it.. I no longer get the Run-Time Error.. but the sheets on Print Preview are completely blank..then Excel crashes and reloads..repaired.
So you were tight that that particular line was wrong...
So you were tight that that particular line was wrong...
ASKER
Just as an FYI... This code is an alternative to the simpler (original one) below..
It checks for zeroes in specific cells, then only sets to print Print Areas where SubTotals > 0.
Code/
Sub PrintCDivSum()
'error trap added for printing support on 64 and 32 bit OS
On Error Resume Next
Dim ws As Worksheet
Dim ws2 As String
Dim DefPrintName As String
DefPrintName = Application.ActivePrinter
UserForm1.Show
If UserForm1.Cancel = "True" Then
Unload UserForm1
Exit Sub
End If
If UserForm1.OK = "True" Then
If UserForm1.OptionButton2.Va lue = True Then
Application.ActivePrinter = "Adobe PDF on Ne02:"
Else: End If
End If
Unload UserForm1
Application.ScreenUpdating = True
ws2 = ActiveSheet.Name
With ThisWorkbook
For Each ws In .Worksheets
Select Case ws.Name
Case "GC's"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l1a,l2a").Address
Worksheets("GC's").Select
.PageSetup.PrintArea = ""
Range("AI65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l1a").Address
End If
Range("AI166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l2a").Address
End If
End With
Case "DIV 2"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l3a,l4a,l5a,l6a,l7 a,l8a,l9a, l10a,l11a, l12a,l13a" ).Address
End With
Case "DIV 3"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l14a,l15a,l16a,l17 a,l18a").A ddress
End With
Case "DIV 4"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l19A").Address
End With
Case "DIV 5"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l20a,l21a").Addres s
End With
Case "DIV 6"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l22a,l23a").Addres s
End With
Case "DIV 7"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l24a,l25a,l26a,l27 a,l28a").A ddress
Worksheets("DIV 7").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l24a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l25a").Address
End If
Range("AN268").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l26a").Address
End If
Range("AN370").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l27a").Address
End If
Range("AN472").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l28a").Address
End If
End With
Case "DIV 8"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l29a,l30a").Addres s
Worksheets("DIV 8").Select 'OK
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l29a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l30a").Address
End If
End With
Case "DIV 9"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l31a,l32a,l33a,l34 a,l35a,l36 a").Addres s
End With
Case "DIV 10" 'OK
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l37a,l38a").Addres s
Worksheets("DIV 10").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l37a").Address
End If
Range("AN166").Select
If ActiveCell.Value <= 0 Then
.PageSetup.PrintArea = ""
'.PageSetup.PrintArea = .Range("l38a").Address
End If
'If ActiveCell.Value = 0 Then
'.PageSetup.PrintArea = .Range("l38a").Address
'End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$
Case "DIV 14"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l39A").Address
Worksheets("DIV 14").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l39a").Address
End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$
Case "DIV 15"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'.PageSetup.PrintArea = .Range("l40A,l41a,l42a").A ddress
Worksheets("DIV 15").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l40a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l41a").Address
End If
Range("AN268").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l42a").Address
End If
End With
Case "DIV 16"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'.PageSetup.PrintArea = .Range("l43A").Address
Worksheets("DIV 16").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l43a").Address
End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$ $$$$$$
'Case Else
End Select
Next ws
End With
Sheets(Array("GC's", "DIV 2", "DIV 3", "DIV 4", "DIV 5", "DIV 6", "DIV 7", "DIV 8", "DIV 9", "DIV 10", "DIV 14", "DIV 15", "DIV 16")).Select
ActiveWindow.SelectedSheet s.PrintPre view
ActiveWindow.SelectedSheet s.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.ActivePrinter = DefPrintName
Application.ScreenUpdating = True
Sheets(ws2).Select
End Sub
\Code
It checks for zeroes in specific cells, then only sets to print Print Areas where SubTotals > 0.
Code/
Sub PrintCDivSum()
'error trap added for printing support on 64 and 32 bit OS
On Error Resume Next
Dim ws As Worksheet
Dim ws2 As String
Dim DefPrintName As String
DefPrintName = Application.ActivePrinter
UserForm1.Show
If UserForm1.Cancel = "True" Then
Unload UserForm1
Exit Sub
End If
If UserForm1.OK = "True" Then
If UserForm1.OptionButton2.Va
Application.ActivePrinter = "Adobe PDF on Ne02:"
Else: End If
End If
Unload UserForm1
Application.ScreenUpdating
ws2 = ActiveSheet.Name
With ThisWorkbook
For Each ws In .Worksheets
Select Case ws.Name
Case "GC's"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l1a,l2a").Address
Worksheets("GC's").Select
.PageSetup.PrintArea = ""
Range("AI65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l1a").Address
End If
Range("AI166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l2a").Address
End If
End With
Case "DIV 2"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l3a,l4a,l5a,l6a,l7
End With
Case "DIV 3"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l14a,l15a,l16a,l17
End With
Case "DIV 4"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l19A").Address
End With
Case "DIV 5"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l20a,l21a").Addres
End With
Case "DIV 6"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l22a,l23a").Addres
End With
Case "DIV 7"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l24a,l25a,l26a,l27
Worksheets("DIV 7").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l24a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l25a").Address
End If
Range("AN268").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l26a").Address
End If
Range("AN370").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l27a").Address
End If
Range("AN472").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l28a").Address
End If
End With
Case "DIV 8"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l29a,l30a").Addres
Worksheets("DIV 8").Select 'OK
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l29a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l30a").Address
End If
End With
Case "DIV 9"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l31a,l32a,l33a,l34
End With
Case "DIV 10" 'OK
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
' .PageSetup.PrintArea = .Range("l37a,l38a").Addres
Worksheets("DIV 10").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l37a").Address
End If
Range("AN166").Select
If ActiveCell.Value <= 0 Then
.PageSetup.PrintArea = ""
'.PageSetup.PrintArea = .Range("l38a").Address
End If
'If ActiveCell.Value = 0 Then
'.PageSetup.PrintArea = .Range("l38a").Address
'End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$
Case "DIV 14"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = .Range("l39A").Address
Worksheets("DIV 14").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l39a").Address
End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$
Case "DIV 15"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'.PageSetup.PrintArea = .Range("l40A,l41a,l42a").A
Worksheets("DIV 15").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l40a").Address
End If
Range("AN166").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l41a").Address
End If
Range("AN268").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l42a").Address
End If
End With
Case "DIV 16"
With ws
.PageSetup.PrintArea = "" 'clear any existing print area
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperLetter
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'.PageSetup.PrintArea = .Range("l43A").Address
Worksheets("DIV 16").Select
.PageSetup.PrintArea = ""
Range("AN65").Select
If ActiveCell.Value > 0 Then
.PageSetup.PrintArea = .Range("l43a").Address
End If
End With
'$$$$$$$$$$$$$$$$$$$$$$$$$
'Case Else
End Select
Next ws
End With
Sheets(Array("GC's", "DIV 2", "DIV 3", "DIV 4", "DIV 5", "DIV 6", "DIV 7", "DIV 8", "DIV 9", "DIV 10", "DIV 14", "DIV 15", "DIV 16")).Select
ActiveWindow.SelectedSheet
ActiveWindow.SelectedSheet
Application.ActivePrinter = DefPrintName
Application.ScreenUpdating
Sheets(ws2).Select
End Sub
\Code
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Ok thanks.. . Sounds good Roy, point well taken. I'll use that function from now on...did not know about it... Much appreciated..
ASKER
.
Pleased to help
ASKER