Link to home
Start Free TrialLog in
Avatar of Ayansane
AyansaneFlag for Guinea

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(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
SOLUTION
Avatar of Roy Cox
Roy Cox
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Ayansane

ASKER

Thx..  Let me check quickly and get back to you...
Hey Roy_Cox,

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

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

Please let me know..
This line is wrong

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

Open in new window


Where are you defining the keys for the dictionary?
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

Open in new window

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
I really appreciate your help.  Thx
Is it working now?
I have not tried it..  Did not know you wanted me to try this code..  Let me check..
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...
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
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Ok thanks..  .  Sounds good Roy, point well taken.  I'll use that function from now on...did not know about it...  Much appreciated..
.
Pleased to help