Sub PrintReports()
'Get all references for all needed ranges
Dim FirstRow As Integer
Dim FileNo As Integer
Dim Shirt As Integer
Dim Trouser As Integer
Dim ReportRng As Range
Dim Entry As Range
Dim Records As Worksheet
Dim ShirtCell As Range
Dim TrouserCell As Range
Set Records = Sheet1 ':::::Change to the name of your data sheet
Set ReportRng = Sheet2.Range("A1") ':::::Change to the name of your report sheet and cell you want it to be in
FileNo = Records.Cells.Find("File no.").Column
FirstRow = Records.Cells.Find("File no.").Row + 1
Shirt = Records.Cells.Find("Shirt").Column
Trouser = Records.Cells.Find("Trouser").Column
'Set up report template
ReportRng = "Name"
ReportRng.Offset(1) = "File No"
ReportRng.Offset(2) = "T Shirt"
ReportRng.Offset(3) = "Trouser"
Sheet2.Range(ReportRng.Offset(, 1).Address, ReportRng.Offset(, 2).Address).Merge
Sheet2.Range(ReportRng.Offset(1, 1).Address, ReportRng.Offset(1, 2).Address).Merge
'Iterate through records and print
With Records
For Each Entry In .Range(.Cells(FirstRow, FileNo), .Cells(.Cells(FirstRow, FileNo).End(xlDown).Row, FileNo))
If Entry.Interior.ColorIndex <> 4 Then
'Get Shirt
Set ShirtCell = .Range(.Cells(Entry.Row, Shirt), .Cells(Entry.Row, Trouser - 1)).Find("1")
If Not ShirtCell Is Nothing Then
ReportRng.Offset(2, 1) = .Cells(FirstRow - 1, ShirtCell.Column)
ReportRng.Offset(2, 2) = ShirtCell
End If
'Get Trouser
Set TrouserCell = .Range(.Cells(Entry.Row, Trouser), .Cells(Entry.Row, Trouser).End(xlToRight)).Find("1")
If Not ShirtCell Is Nothing Then
ReportRng.Offset(3, 1) = .Cells(FirstRow - 1, TrouserCell.Column)
ReportRng.Offset(3, 2) = TrouserCell
End If
'Get Name & File number
ReportRng.Offset(, 1) = Entry.Offset(, -1)
ReportRng.Offset(1, 1) = Entry
'Print report
Range(ReportRng, ReportRng.Offset(3, 2)).PrintOut
'Set cell to printed
Entry.Interior.ColorIndex = 4
End If
Next Entry
End With
End Sub
