How can I collect all print previews created from for loop in vba?

Question

I have a list box from which I want to print preview reports for all of the selected customers in single print preview. There is a video on youtube related to this --> https://youtu.be/962Hd4akras , which gives some idea about how it can be achieved, if you have data on separate sheets. But in my case I am using for loops to get data for selected customers. I'm collecting data one by one and putting it into a sheet where I have some formatting done. My code gives separate print previews for each selected customer. But what I want is to get combined print preview for all the customers(Multipage print preview). Here is my code. Note:I have fixed worksheet as well print area.

Sub SlipMacro2()

'Getting customer code number

Dim i, c, d As Long, FarmerCode As Integer
Dim SlipArray() As Integer

With PaymentMaster.lstDatabase
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            ReDim Preserve SlipArray(c)
            SlipArray(c) = .List(i)
            c = c + 1
        End If
    Next i
End With

For d = 0 To c - 1

    FarmerCode = SlipArray(d)

'Copying information 

    Dim pd, ps As Worksheet
    
    Set pd = ThisWorkbook.Sheets("purchasedata")
    Set ps = ThisWorkbook.Sheets("paymentslip")
    
    ps.Range("B8:N23").ClearContents

    Dim a, lr, j, b As Integer

    With PaymentMaster
    
        a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
        lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
        ps.Range("I5") = CDate(.TextBox1.Value)
        ps.Range("L5") = CDate(.TextBox2.Value)
        ps.Range("C5") = FarmerCode
        
        For j = 0 To a
            For b = 2 To lr
                If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                    ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                    If pd.Range("C" & b) = "Morning" Then
                        ps.Range("C" & j + 8) = pd.Range("E" & b)
                        ps.Range("D" & j + 8) = pd.Range("F" & b)
                        ps.Range("E" & j + 8) = pd.Range("G" & b)
                        ps.Range("F" & j + 8) = pd.Range("H" & b)
                        ps.Range("G" & j + 8) = pd.Range("I" & b)
                        ps.Range("H" & j + 8) = pd.Range("J" & b)
                    ElseIf pd.Range("C" & b) = "Evening" Then
                        ps.Range("I" & j + 8) = pd.Range("E" & b)
                        ps.Range("J" & j + 8) = pd.Range("F" & b)
                        ps.Range("K" & j + 8) = pd.Range("G" & b)
                        ps.Range("L" & j + 8) = pd.Range("H" & b)
                        ps.Range("M" & j + 8) = pd.Range("I" & b)
                        ps.Range("N" & j + 8) = pd.Range("J" & b)
                    End If
                End If
            Next b
        Next j
    
    End With
    
ThisWorkbook.Sheets("paymentslip").PrintPreview

Next d

End Sub

Do you need PrintPreview for some other sheets except "paymentslip"? I see that you only use `SlipArray` to fill `FarmerCode` in "C5"... — FaneDuru, Aug 22 '20 at 18:27
Basically what I am doing is replacing data every time the loop runs and getting a print preview for every single customer one by one, but I want all of the print previews collected in single print preview. — Nikhil Bhor, Aug 23 '20 at 05:00

DecimalTurn · Answer 1 · 2020-08-23T20:56:59.720

It is not possible to store the result of a print preview or combine multiple print previews that you previously got into a new print preview.

Knowing that, you could instead make copies of the sheet "paymentslip" using the Copy method at each step and create a print preview that combines all those copies.

For that, you would store the name of those sheet inside an array and you can pass that array with the name of those sheets to the Sheets object to do a PrintPreview of more than one sheet.

Note that this will generate many sheets, so we need to make sure that the code deletes those older copies at the beggining of

In your code, this would look like this:

Sub SlipMacro2()

    'Getting customer code number

    Dim i, c, d As Long, FarmerCode As Integer
    Dim SlipArray() As Integer

    With PaymentMaster.lstDatabase
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve SlipArray(c)
                SlipArray(c) = .list(i)
                c = c + 1
            End If
        Next i
    End With

    For d = 0 To c - 1

        FarmerCode = SlipArray(d)

        'Copying information

        Dim pd, ps As Worksheet
    
        Set pd = ThisWorkbook.Sheets("purchasedata")
        Set ps = ThisWorkbook.Sheets("paymentslip")
    
        ps.Range("B8:N23").ClearContents

        Dim a, lr, j, b As Integer

        With PaymentMaster
    
            a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
            lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
            ps.Range("I5") = CDate(.TextBox1.Value)
            ps.Range("L5") = CDate(.TextBox2.Value)
            ps.Range("C5") = FarmerCode
        
            ''''''''''''''''''''''''''''''''''''''
            ' Delete older copies
            ''''''''''''''''''''''''''''''''''''''
            Dim ws As Worksheet
            For Each ws In ThisWorkbook.Worksheets
                If ws.Name Like ps.Name & " (*)" Then
                    Application.DisplayAlerts = False
                    ws.Delete
                    Application.DisplayAlerts = True
                End If
            Next

            ''''''''''''''''''''''''''''''''''''''
            ' Create list of sheets for the Print Preview
            ''''''''''''''''''''''''''''''''''''''
            Dim SheetsList() As Variant
            ReDim SheetsList(0 To a)
        
            For j = 0 To a
                For b = 2 To lr
                    If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                        ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                        If pd.Range("C" & b) = "Morning" Then
                            ps.Range("C" & j + 8) = pd.Range("E" & b)
                            ps.Range("D" & j + 8) = pd.Range("F" & b)
                            ps.Range("E" & j + 8) = pd.Range("G" & b)
                            ps.Range("F" & j + 8) = pd.Range("H" & b)
                            ps.Range("G" & j + 8) = pd.Range("I" & b)
                            ps.Range("H" & j + 8) = pd.Range("J" & b)
                        ElseIf pd.Range("C" & b) = "Evening" Then
                            ps.Range("I" & j + 8) = pd.Range("E" & b)
                            ps.Range("J" & j + 8) = pd.Range("F" & b)
                            ps.Range("K" & j + 8) = pd.Range("G" & b)
                            ps.Range("L" & j + 8) = pd.Range("H" & b)
                            ps.Range("M" & j + 8) = pd.Range("I" & b)
                            ps.Range("N" & j + 8) = pd.Range("J" & b)
                        End If
                    End If
                Next b

                ''''''''''''''''''''''''''''''''''''''
                ' Make a copy of the sheet at the end of the workbook
                ''''''''''''''''''''''''''''''''''''''
                SheetsList(j) = CopySheetAtTheEnd(ps).Name
            
            Next j
    
        End With

        ''''''''''''''''''''''''''''''''''''''
        ' Pass the array to the Sheets object to get more than one sheet
        ''''''''''''''''''''''''''''''''''''''        
        ThisWorkbook.Sheets(SheetsList()).PrintPreview

    Next d

End Sub

Aslo make sure to include the following function:

Function CopySheetAtTheEnd(ByRef ws As Worksheet) As Worksheet
'This function is robust to the presence of hidden sheets
'Based on this answer: https://stackoverflow.com/a/24041228/5958842

    Dim wb As Workbook
    Set wb = ws.Parent
    Dim IsLastSheetVisible As Boolean
    
    With wb
        IsLastSheetVisible = .Sheets(.Sheets.Count).Visible
        .Sheets(Sheets.Count).Visible = True
        .Sheets(ws.Name).Copy AFTER:=.Sheets(Sheets.Count)
        Set CopySheetAtTheEnd = .Sheets(Sheets.Count)
        If Not IsLastSheetVisible Then .Sheets(Sheets.Count - 1).Visible = False
    End With

End Function

No that would work if I have separate sheets for every customer, but my data is stored in collected form in "purchasedata" sheet, from where I am collecting data for every selected customer one by one and putting it into a sheet called "paymentslip" every time the loop runs.(in same location) — Nikhil Bhor, Aug 23 '20 at 05:17
@NikhilBhor – Oh, I see. I had misunderstood your question. I've edited my answer to better answer your question. Hope this helps. — DecimalTurn, Aug 23 '20 at 06:50
Thanks for your efforts. I tried your code, but I am getting an error "Variable not defined" at "Delete other copies" and the variable is "wb" in line `For Each ws In wb.Worksheets` so I tried removing Option Explicit, but then I got runtime error 424 "Object Required" at same line. — Nikhil Bhor, Aug 23 '20 at 10:05
@NikhilBhor – `wb` needs to be changed to `ThisWorkbook` in your case. I've edited the answer again to make this correction. — DecimalTurn, Aug 23 '20 at 10:08
I tried that too, forgot to mention, it gave me runtime error 9 "Subscript out of range" at `ThisWorkbook.Sheets(SheetsList()).PrintPreview` this line — Nikhil Bhor, Aug 23 '20 at 10:23
@NikhilBhor – Sorry, I was working with different bit of code. `SheetsList(i) = AddSheetAtTheEnd(ps).Name` should be `SheetsList(j) = AddSheetAtTheEnd(ps).Name` — DecimalTurn, Aug 23 '20 at 11:12
Sorry, but its giving error "Subscript out of range" at `SheetsList(j) = AddSheetAtTheEnd(ps).Name` this line now — Nikhil Bhor, Aug 23 '20 at 12:16

score 0 · Accepted Answer · answered Aug 23 '20 at 12:30

Sorry for all the trouble, I found following solution for it

Sub SlipMacro2()

Dim i, c, d As Long, FarmerCode As Integer
Dim SlipArray() As String

With PaymentMaster.lstDatabase
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            ReDim Preserve SlipArray(c)
            SlipArray(c) = .List(i)
            c = c + 1
        End If
    Next i
End With

For d = 0 To c - 1

    FarmerCode = SlipArray(d)

    Dim pd, ps As Worksheet
    
    Set pd = ThisWorkbook.Sheets("purchasedata")
    Set ps = ThisWorkbook.Sheets("paymentslip")
    
    ps.Range("B8:N23").ClearContents

    Dim a, lr, j, b As Integer

    With PaymentMaster
    
        a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
        lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
        ps.Range("I5") = CDate(.TextBox1.Value)
        ps.Range("L5") = CDate(.TextBox2.Value)
        ps.Range("C5") = FarmerCode
        
        For j = 0 To a
            For b = 2 To lr
                If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                    ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                    If pd.Range("C" & b) = "Morning" Then
                        ps.Range("C" & j + 8) = pd.Range("E" & b)
                        ps.Range("D" & j + 8) = pd.Range("F" & b)
                        ps.Range("E" & j + 8) = pd.Range("G" & b)
                        ps.Range("F" & j + 8) = pd.Range("H" & b)
                        ps.Range("G" & j + 8) = pd.Range("I" & b)
                        ps.Range("H" & j + 8) = pd.Range("J" & b)
                    ElseIf pd.Range("C" & b) = "Evening" Then
                        ps.Range("I" & j + 8) = pd.Range("E" & b)
                        ps.Range("J" & j + 8) = pd.Range("F" & b)
                        ps.Range("K" & j + 8) = pd.Range("G" & b)
                        ps.Range("L" & j + 8) = pd.Range("H" & b)
                        ps.Range("M" & j + 8) = pd.Range("I" & b)
                        ps.Range("N" & j + 8) = pd.Range("J" & b)
                    End If
                End If
            Next b
        Next j
    
    End With
    
ps.Copy after:=ps
ActiveSheet.Name = FarmerCode

Next d

ThisWorkbook.Sheets(SlipArray()).PrintPreview
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SlipArray()).Delete
Application.DisplayAlerts = True

End Sub

You don't have to feel sorry; I'm glad you found a way to solve your problem! — DecimalTurn, Aug 23 '20 at 20:47
I see that your solution is slightly more adapted for your situation as you are renaming the copies of the "paymentslip" sheet to suit your needs. However, be careful in using the ActiveSheet object in your code ([see here](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba)). Your answer is also simpler as you only use the `Copy` method instead of the more robust function that I provided. However, in the end, the core ideas in your answer are still the ones in my answer: Creating copies of the sheet and doing a print preview for all those copied sheets. — DecimalTurn, Aug 23 '20 at 20:56

How can I collect all print previews created from for loop in vba?

2 Answers2