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(xlDialogPrinterSetup).Show Then Exit Sub
Case vbCancel
'Abort
Exit Sub
End Select

Set DictC = CreateObject("Scripting.Dictionary")
DictC.CompareMode = vbTextCompare
' SheetName, Cells for zero check
DictC.Add "GC's", "AI65,AI166"
DictC.Add "DIV 2", "AN65,AN166,AN268,AN370,AN472,AN778,AN880,AN982,AN1084"
DictC.Add "DIV 3", "AN65,AN166,AN268,AN370,AN472,AN778,AN880,AN982,AN1084"
DictC.Add "DIV 4", "AN65,AN166,AN268,AN370,AN472"
DictC.Add "DIV 5", "AN65,AN166"
DictC.Add "DIV 6", "AN65,AN166"
DictC.Add "DIV 7", "AN65,AN166,AN268,AN370,AN472,AG5:AP65,AG5:AP472,AG205:AP268"
DictC.Add "DIV 8", "AN65,AN166"
DictC.Add "DIV 9", "AN65,AN166,AN268,AN370,AN472,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.Dictionary")
DictP.CompareMode = vbTextCompare
' SheetName, PrintArea
DictP.Add "GC's", "11a,12a"
DictP.Add "DIV 2", "13a,14a,15a,16a,17a,18a,19a,110a,111a,112a,113a"
DictP.Add "DIV 3", "l14a,l15a,l16a,l17a,l18a" '_SHT14,_SHT15,_SHT16,_SHT17,_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,_SHT27,_SHT28"
DictP.Add "DIV 8", "l29a,l30a" '_SHT29,_SHT30"
DictP.Add "DIV 9", "l31a,l32a,l33a,l34a,l35a,l36a" '_SHT31,_SHT32,_SHT33,_SHT34,_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(SheetName))
'Skip if zero
If WorksheetFunction.Sum(ThisRange) <> 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(SheetName))
.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).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ThisSheet.Select
End If

Application.ActivePrinter = SaveActivePrinter
End Sub
/code
AyansaneAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
I would think there is a problem with a sheet name, have you checked what is in the sheet name after the error?
AyansaneAuthor Commented:
Thx..  Let me check quickly and get back to you...
AyansaneAuthor Commented:
Hey Roy_Cox,

So after the "error", the sheet name is "DIV 2"....

It still stops right there..
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

AyansaneAuthor Commented:
Yes... it does..  Please help..    Thx
Roy CoxGroup Finance ManagerCommented:
Can you attach the workbook
AyansaneAuthor Commented:
The file is too big to be uploaded..   Can I Dropbox it to you..   Or could you send me a DropBox upload link.?  Thx
AyansaneAuthor Commented:
I can also email to you..   I'm at ArbeitWali<at>Gmail<.>Com
AyansaneAuthor Commented:
This link may work....:    https://drive.google.com/file/d/0B_C9CGARkEdaZW1HNzd2bzZteVk/view?usp=sharing

Please let me know..
Roy CoxGroup Finance ManagerCommented:
This line is wrong

Set ThisRange = .Range(DictP.Item(SheetName))

Open in new window


Where are you defining the keys for the dictionary?
AyansaneAuthor Commented:
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..
Roy CoxGroup Finance ManagerCommented:
Is this correct?

'Set print area if any
        If DictP.Exists(SheetName) Then
          Set ThisRange = ThisRange
          .PageSetup.PrintArea = ThisRange.Address
        End If

Open in new window

AyansaneAuthor Commented:
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(SheetName))
                   .PageSetup.PrintArea = ThisRange.Address
              End If
AyansaneAuthor Commented:
I really appreciate your help.  Thx
Roy CoxGroup Finance ManagerCommented:
Is it working now?
AyansaneAuthor Commented:
I have not tried it..  Did not know you wanted me to try this code..  Let me check..
AyansaneAuthor Commented:
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...
AyansaneAuthor Commented:
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.Value = 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,l7a,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,l17a,l18a").Address
                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").Address
                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").Address
                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,l27a,l28a").Address
                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").Address
                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,l34a,l35a,l36a").Address
                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").Address
                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").Address
                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.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

Application.ActivePrinter = DefPrintName
Application.ScreenUpdating = True
Sheets(ws2).Select

End Sub
\Code
Roy CoxGroup Finance ManagerCommented:
I thought you were overcomplicating the code. I'll go through your code later - there is still room for improvement

Note for future posts that when you post code it is much easier to read if you select it and click the CODE button in the Toolbar of the post.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
AyansaneAuthor Commented:
Ok thanks..  .  Sounds good Roy, point well taken.  I'll use that function from now on...did not know about it...  Much appreciated..
AyansaneAuthor Commented:
.
Roy CoxGroup Finance ManagerCommented:
Pleased to help
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.