Printing Tabs Issue

[spongebob]

Hello All,

I had something written a while back ago and its been overall pretty flawless, but recently it's decided to not work.
the part in particular is related to printing the tabs within the current document.
We have a list in a column of excluded tabs, and the script goes out and makes PDF's for the rest of the tabs, then physically prints the first page of each document.
Unfortunately with no error trapping, I don't get much value to help diagnose the issue.
After saving the first PDF printing it, it then crashes with a run-time error '1004':

if I click debug, I get the following:
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

I have attached the 2 functions that save the PDF and Print, any assistance appreciated...

Private Sub InvoicePdf(ws As Worksheet, CoName As String, SerPeriod As String)
Dim tempstring As String
If Right(ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value, 1) = "\" Then
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
Else
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & "\" & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ws.PrintOut From:=1, To:=1, Copies:=1, Preview:=False
End Sub
Sub PrintAllSheets()
Dim mySht As Worksheet
Dim timestartp As String
timestartp = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
For Each mySht In ThisWorkbook.Worksheets
    With mySht
        If IsError(Application.Match(.Name, Sheets("Mapping_DB").Range("ExclTabs").Value, 0)) Then
            Call InvoicePdf(mySht, mySht.Range("B5").Value, mySht.Range("D2").Value)
        End If
    End With
Next mySht
MsgBox "Done, started at " & timestartp & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub

 

[davesexcel]

I don't see ws variable set? maybe it is from another sub?

 

[spongebob]

I do see a few places in the other functions which refer to ws...
those functions get a bit more complex and also the data is needed to test, which has tons of sensitive info... tough to share.

 

[davesexcel]

So do you know if ws is set?

 

[spongebob]

it looks like it is, but I'm not a VB person...
it pulls the first tab, saves the PDF, and prints the first page from it, but then just stops.
Not sure if maybe the size of the doc is getting too big.
Between 50 tabs or so and one or 2 tabs containing maybe 100K lines, it may be bad.
let me see if I can copy the whole script here, I don't think the script itself have too much sensative info.

 

[spongebob]

I will try to explain the steps.
We populate 5 tabs with tons of data (tabs can have 500-100,000 lines of data), within each of those tabs there is a column which has a client name/abbreviation.
We have a mapping tab, that has a way to map, which name/abbreviation from the data column associates with each invoice tab (roughly 50).
That mapping tab has a pre-defined list, but then we run SetupMasters, which goes through the data, figures out what names exist, and looks for it in the pre-defined list, and puts it in an active list.
Any data that has a name which is not in the predefined list, shows up on the active list, and you have to point it to an invoice tab it should be associated with.
Assuming everything was predefined and no new name/abbreviation is found, then everything is setup and the active list is used for processing the next step.

Now we run the process macro, which goes through each data tab, finds matching records for each invoice tab, and populates each data tab into the appropriate section on the invoice tab.
[ Example each invoice tab lets say has incoming/outgoing/ etc sections and the data is grabbed from the associated data tab into that section, creating sub totals for each service type ]
Recently ran into some similar issues, with the process function.
Now once it's processed this means all the data from all 5 data tabs, was distributed to the correct client invoice tab/section.
At this point we can see what each invoice looks like, who its for etc. [Rates tab has the client info and rates for the different services].

Thats when we run the next step PrintAllSheets, which goes out and saves a PDF file for each of the tabs, and prints the first page from each tab.
[Note: within the mapping tab, we also have a print exclusion list ( simple list of tab names) so that we don't print IN/OUT/RATES/REP/Mapping_DB etc. but only print legit invoice tabs.]


Hopefully this makes some sense as its not that complicated coding wise, but more so to understand the process and what it does.

Thanks!

Option Explicit
Sub Process()
Dim j As Long, k As Long, l As Long
Dim timestart As String
timestart = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For j = 2 To LastRow(Sheets("Mapping_DB"), "A")
If IsError(Sheets("Mapping_DB").Cells(j, 1).Value) = True Then
    Sheets("Mapping_DB").Cells(j, 3).Value = "Error"
ElseIf Sheets("Mapping_DB").Cells(j, 1).Value <> "" Then
    If WorksheetExists(Sheets("Mapping_DB").Cells(j, 2).Value) = True Then
    'On Error Resume Next
        Call PopulateNow(Sheets("IN"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Incoming", 23)
        Call PopulateNow(Sheets("Out"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Outgoing", 24)
        Call PopulateNow(Sheets("Int"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "LD", 24, "L")
        Call PopulateNow(Sheets("Toll"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "TollFree", 24, "T")
        Call PopulateNow(Sheets("FAX"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Fax", 25)
    'On Error GoTo 0
    Else
        Sheets("Mapping_DB").Cells(j, 3).Value = "Check"
    End If
End If
Next j
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
MsgBox "Done, started at " & timestart & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub
Private Sub PopulateNow(wsSource As Worksheet, wsTarget As Worksheet, SearchString As String, Marker As String, RowNumber As Long, Optional FormulaIndicator As String)
Dim Rng As Range
Dim rw As Long, GapRow As Long, OrigGapRow As Long
If FormulaIndicator = "T" Then
    GapRow = 2
    OrigGapRow = 2
Else
    GapRow = 3
    OrigGapRow = 3
End If
If wsTarget.Cells(wsTarget.Range(Marker).Row + GapRow, 1).Value <> "" Then GapRow = wsTarget.Range("A" & wsTarget.Range(Marker).Row + GapRow).End(xlDown).Row + 1 - wsTarget.Range(Marker).Row
wsSource.UsedRange.AutoFilter
wsSource.UsedRange.AutoFilter Field:=9, Criteria1:="=" & SearchString
Set Rng = wsSource.Range("A2", wsSource.Range("A" & Rows.CountLarge).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng.Cells.CountLarge > 1 Then
    wsTarget.Activate
    wsTarget.Rows("" & wsTarget.Range(Marker).Row + GapRow & ":" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge - 1).Select
    Selection.EntireRow.Insert shift:=xlDown
    wsSource.Range("A2", wsSource.Range("G" & Rows.CountLarge).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
    wsTarget.Activate
    Range(Marker).Offset(GapRow, 0).PasteSpecial xlPasteValuesAndNumberFormats
    For rw = (wsTarget.Range(Marker).Row + GapRow) To (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge - 1)
        If FormulaIndicator = "L" Then
            Range("H" & rw).Formula = "=IF($F" & rw & "<$C$" & RowNumber & ",(D" & rw & "/60)*($C$" & RowNumber & "*1.3),(D" & rw & "/60)*(($F" & rw & "*$M$4) +F" & rw & "))"
        ElseIf FormulaIndicator = "T" Then
            Range("H" & rw).Formula = "=IF(E" & rw & "=""Toll-Free:Canada"",D" & rw & "/60*($M$6),IF(E" & rw & "=""Toll-Free:Alaska"",D" & rw & "/60*($M$7),IF(E" & rw & "=""Toll-Free:Puerto Rico"",D" & rw & "/60*($M$8),D" & rw & "/60*($M$5))))"
        Else
            Range("H" & rw).Formula = "=D" & rw & "/60*$C$" & RowNumber
        End If
    Next rw
    'Check if more than 1 blank rows are there below & delete them
    If wsTarget.Range("A" & (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge) + 1).Value = "" Then
        Rows("" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & ":" & Range("A" & (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge)).End(xlDown).Row - 2).Select
        Selection.EntireRow.Delete
    End If
    Rows(wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge).Copy
    Range("A" & wsTarget.Range(Marker).Row + GapRow & ":H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    Range("C" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge + 1).Formula = "=COUNT(D" & wsTarget.Range(Marker).Row + OrigGapRow & ":D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & ")"
    Range("D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge + 1).Formula = "=SUM(D" & wsTarget.Range(Marker).Row + OrigGapRow & ":D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & ")/60"
    Range("F" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge + 1).Formula = "=AVERAGE(F" & wsTarget.Range(Marker).Row + OrigGapRow & ":F" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & ")"
    Range("G" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge + 1).Formula = "=ROUND(SUM(G" & wsTarget.Range(Marker).Row + OrigGapRow & ":G" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & "),2)"
    Range("H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge + 1).Formula = "=ROUND(SUM(H" & wsTarget.Range(Marker).Row + OrigGapRow & ":H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.CountLarge & "),2)"
End If
Sheets("Mapping_DB").Activate
End Sub
Sub SetupMasters()
Dim i As Long
Dim cell As Range
Dim timestartm As String
timestartm = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Mapping_DB").Range("Sheet_Names").Clear
For i = 2 To Application.Sheets.Count
    Sheets("Mapping_DB").Range("D" & i) = Application.Sheets(i).Name
Next
ActiveWorkbook.Names("Sheet_Names").RefersTo = Sheets("Mapping_DB").Range("D2:D" & LastRow(Sheets("Mapping_DB"), "D"))
With Sheets("Mapping_DB")
    .Range("A2:B" & .UsedRange.Rows.Count).Clear
    Sheets("IN").Range("I2:I" & LastRow(Sheets("IN"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("OUT").Range("I2:I" & LastRow(Sheets("OUT"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("FAX").Range("I2:I" & LastRow(Sheets("FAX"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("Int").Range("I2:I" & LastRow(Sheets("Int"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("Toll").Range("I2:I" & LastRow(Sheets("Toll"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    .Range("A1:A" & LastRow(Sheets("Mapping_DB"), "A")).RemoveDuplicates Columns:=1, Header:=xlYes
    For Each cell In .Range("A2:A" & LastRow(Sheets("Mapping_DB"), "A"))
        cell.Offset(0, 1).Validation.Delete
        cell.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Sheet_Names"
        cell.Offset(0, 1).Formula = "=iferror(vlookup(" & cell.Address & ",F:G,2,0),0)"
    Next cell
End With
Application.ScreenUpdating = True
MsgBox "Done, started at " & timestartm & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub
Function LastRow(ws As Worksheet, Optional ColName As String) As Long
If ColName = "" Then
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
Else
LastRow = ws.Range("" & ColName & Rows.Count).End(xlUp).Row
End If
End Function
Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
    For Each Sht In ThisWorkbook.Worksheets
        If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next Sht
WorksheetExists = False
End Function

Private Sub InvoicePdf(ws As Worksheet, CoName As String, SerPeriod As String)
Dim tempstring As String
If Right(ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value, 1) = "\" Then
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
Else
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & "\" & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ws.PrintOut From:=1, To:=1, Copies:=1, Preview:=False
End Sub
Sub PrintAllSheets()
Dim mySht As Worksheet
Dim timestartp As String
timestartp = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
For Each mySht In ThisWorkbook.Worksheets
    With mySht
        If IsError(Application.Match(.Name, Sheets("Mapping_DB").Range("ExclTabs").Value, 0)) Then
            Call InvoicePdf(mySht, mySht.Range("B5").Value, mySht.Range("D2").Value)
        End If
    End With
Next mySht
MsgBox "Done, started at " & timestartp & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub

 

[davesexcel]

I assume you are getting the error because you have not set the ws variable.

You mentioned in the 1st post that it used to work for you. I would then assume the ws.variable was set at one time.

 

[spongebob]

The code hasnt changed, can you tell me what I should try? and where to set this variable?

 

[spongebob]

We create these monthly taking a master file and adding data for a month.
In comparing all VB from last month to this month, it's identical, however something possibly data wise within certain tabs are what I believe may be breaking it, but not able to see what.

 

[lrobbo314]

The 'PrintAllSheets' sub is passing the 'mySht' variable to the 'InvoicePDF' sub.

The 'mySht' variable is being set in this loop.

For Each mySht In ThisWorkbook.Worksheets
    With mySht
        If IsError(Application.Match(.Name, Sheets("Mapping_DB").Range("ExclTabs").Value, 0)) Then
            Call InvoicePdf(mySht, mySht.Range("B5").Value, mySht.Range("D2").Value)
        End If
    End With
Next mySht

So it's not to do with 'ws' not being set.

Maybe it has something to do with the filename.