Skeeeter56
New Member
This code works perfectly, it loops through 14 columns looking for value in 1 of 5 rows. Each of the 5 rows have a group of Named ranges. If the value is True, it copies 3 ranges in same column to 1 of 5 worksheets and then prints, it then loops back again and repeats till complete. This runs when a button is clicked and if all columns had True would print 70 sheets.
I have another button for if the value is False; it will also copy the ranges and print but a little bit differently
It loops through 14 columns looking for the False value in each row, and at end of each row it then Prints. Once again there 1 of 5 worksheets these are formatted with 3 pages each this allows if there is a value in all, which will be very rare.
Each row has a set of ranges they are
Row 23 Nuna1 to Nuna14
Row 31 Verm1 to Verm14
Row 43 Mitch 1 to Mitch14
Row 58 Black1 to Black14
Row 78 Boxhill1 to Boxhill14
So at the completion of each row it prints the worksheet and then goes to next row. I have included a screenshot of 1 of these worksheets I have typed in where I want the data that is copied, this matches what I have in the workbook currently. Here if all columns had False needs to print 5 Worksheets each with up to 3 pages that's 15 pages.
I hope this makes sense I have been playing with this for about a week
This is the code
I have another button for if the value is False; it will also copy the ranges and print but a little bit differently
It loops through 14 columns looking for the False value in each row, and at end of each row it then Prints. Once again there 1 of 5 worksheets these are formatted with 3 pages each this allows if there is a value in all, which will be very rare.
Each row has a set of ranges they are
Row 23 Nuna1 to Nuna14
Row 31 Verm1 to Verm14
Row 43 Mitch 1 to Mitch14
Row 58 Black1 to Black14
Row 78 Boxhill1 to Boxhill14
So at the completion of each row it prints the worksheet and then goes to next row. I have included a screenshot of 1 of these worksheets I have typed in where I want the data that is copied, this matches what I have in the workbook currently. Here if all columns had False needs to print 5 Worksheets each with up to 3 pages that's 15 pages.
I hope this makes sense I have been playing with this for about a week
This is the code
Code:
Private Sub cboPrintBus_Click()
Dim shData As Worksheet, shGroup As Worksheet
Dim arrSh As Variant, arrCe As Variant, arrRn As Variant, arrCl As Variant
Dim i As Long, j As Long, k As Long, lr As Long
Application.ScreenUpdating = False
arrSh = Array("Nunawading Bus", "Vermont Bus", "Mitcham Bus", "Blackburn Bus", "Box Hill Bus") 'Names of the 5 destinations Sheets
arrCe = Array(23, 33, 43, 58, 78) 'Rows where arrRn ranges are located,
arrRn = Array("Nuna", "Verm", "Mitch", "Black", "Boxhill") 'The ranges that get copied and each have a number like Nuna1 through to Last Nuna14
arrNm = Array("Name")
arrCo = Array("Code")
arrCl = Array("Clear7", "Clear8", "Clear9", "Clear10", "Clear11") 'This clears the Destinations sheets after Printing is complete
Set shData = ThisWorkbook.Worksheets("Week Commencing")
For i = 0 To UBound(arrSh)
Set shGroup = Sheets(arrSh(i))
k = 1
For j = Columns("D").Column To Columns("Q").Column
If shData.Cells(arrCe(i), j) = False Then
shData.Range(arrRn(i) & k).Copy
lr = 5
shGroup.Range("B7").PasteSpecial Paste:=xlPasteValues
shData.Range(arrNm(0) & k).Copy
shGroup.Range("C4").PasteSpecial Paste:=xlPasteValues
shData.Range(arrCo(0) & k).Copy
shGroup.Range("C5").PasteSpecial Paste:=xlPasteValues
'MsgBox Printed
shGroup.PrintPreview
End If
k = k + 1
Next j
Next i
For i = 0 To UBound(arrSh)
Set shGroup = Sheets(arrSh(i))
shGroup.Range(arrCl(i)).ClearContents
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub