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
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