skeeeet
08-22-2020, 01:41 PM
Hi I have been assisted with this code in this post
https://www.myonlinetraininghub.com/excel-forum/vba-macros/change-to-code-if-a-value-is-false-need-to-print-to-different-sheets-and-format-to-if-it-is-true
The code is sort of working just not putting the data where it should, I have asked at that forum but as yet no answer.
The code is used to print sheets which copies data from main worksheet, there are 2 different types of printout. Which one is decided by if a valuer is true or false. I have them on 2 Buttons but once both working like them to be on 1 button.
There are 5 groups of data and 14 columns that it loops through. Row no's 22, 32, 42, 57 & 77 contain either a True , False or 1 in the columns D to Q.
The Button for True works exactly as I want. Each time it finds a True value it copies some values to a destination Worksheet and then prints, it then loops to the next true value and repeats. A 2nd loop at that end of each of the rows changes the destination Worksheet. So if there is a True value in all 70 it would print 70 pages.
The Button for False copies the values a little differently, I want it to print only at the end of each of the 5 Rows 22, 32, 42, 57 & 77 to the destination worksheets. It would then loop to next row and repeat.So here if it finds False in the 70 locations only 15 pages that's 3 pages per destination worksheet.
The issue is that it is not placing the copied data in the correct locations, also if there are no False values found on a row no pages are printed.
I have uploaded an example file with data in it, I have run code and not cleared the destination sheets so it shows where it is copying in correctly.
Private Sub cboPrintUMS_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
Dim outCell As Range, inCell As Range
Application.ScreenUpdating = False
arrSh = Array("Nunawading Bus", "Vermont Bus", "Mitcham Bus", "Blackburn Bus", "Box Hill Bus") 'Names of the 5 destinations Sheets
arrCe = Array(22, 32, 42, 57, 77) '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
Dim col As Byte, rw As Byte, off As Byte
rw = 3 'for first 5 items; will be 24 for next 5 and 50 for last 4
col = 3 ' column C for first 5, increase with 2 columns step, reset to column C each 5 items
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
shGroup.Cells(rw, col).Value = shData.Range(arrNm(0) & k).Value
shGroup.Cells(rw + 1, col).Value = shData.Range(arrCo(0) & k).Value
shGroup.Range(shGroup.Cells(rw + 3, col - 1), shGroup.Cells(rw + 3 + shData.Range(arrRn(i) & k).Cells.Count - 1, col - 1)).Value = shData.Range(arrRn(i) & k).Value
col = col + 2
'reset row and col at each 5 items
If j = 5 Then
rw = 24
col = 3
End If
If j = 11 Then
rw = 50
col = 3
End If
End If
k = k + 1
Next j
shGroup.PrintPreview
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
26994
This is a Destination Worksheet all 5 are the same all have 3 pages the only difference is that some have more rows per page.
I really hope someone can figure out what is going on here.
https://www.myonlinetraininghub.com/excel-forum/vba-macros/change-to-code-if-a-value-is-false-need-to-print-to-different-sheets-and-format-to-if-it-is-true
The code is sort of working just not putting the data where it should, I have asked at that forum but as yet no answer.
The code is used to print sheets which copies data from main worksheet, there are 2 different types of printout. Which one is decided by if a valuer is true or false. I have them on 2 Buttons but once both working like them to be on 1 button.
There are 5 groups of data and 14 columns that it loops through. Row no's 22, 32, 42, 57 & 77 contain either a True , False or 1 in the columns D to Q.
The Button for True works exactly as I want. Each time it finds a True value it copies some values to a destination Worksheet and then prints, it then loops to the next true value and repeats. A 2nd loop at that end of each of the rows changes the destination Worksheet. So if there is a True value in all 70 it would print 70 pages.
The Button for False copies the values a little differently, I want it to print only at the end of each of the 5 Rows 22, 32, 42, 57 & 77 to the destination worksheets. It would then loop to next row and repeat.So here if it finds False in the 70 locations only 15 pages that's 3 pages per destination worksheet.
The issue is that it is not placing the copied data in the correct locations, also if there are no False values found on a row no pages are printed.
I have uploaded an example file with data in it, I have run code and not cleared the destination sheets so it shows where it is copying in correctly.
Private Sub cboPrintUMS_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
Dim outCell As Range, inCell As Range
Application.ScreenUpdating = False
arrSh = Array("Nunawading Bus", "Vermont Bus", "Mitcham Bus", "Blackburn Bus", "Box Hill Bus") 'Names of the 5 destinations Sheets
arrCe = Array(22, 32, 42, 57, 77) '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
Dim col As Byte, rw As Byte, off As Byte
rw = 3 'for first 5 items; will be 24 for next 5 and 50 for last 4
col = 3 ' column C for first 5, increase with 2 columns step, reset to column C each 5 items
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
shGroup.Cells(rw, col).Value = shData.Range(arrNm(0) & k).Value
shGroup.Cells(rw + 1, col).Value = shData.Range(arrCo(0) & k).Value
shGroup.Range(shGroup.Cells(rw + 3, col - 1), shGroup.Cells(rw + 3 + shData.Range(arrRn(i) & k).Cells.Count - 1, col - 1)).Value = shData.Range(arrRn(i) & k).Value
col = col + 2
'reset row and col at each 5 items
If j = 5 Then
rw = 24
col = 3
End If
If j = 11 Then
rw = 50
col = 3
End If
End If
k = k + 1
Next j
shGroup.PrintPreview
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
26994
This is a Destination Worksheet all 5 are the same all have 3 pages the only difference is that some have more rows per page.
I really hope someone can figure out what is going on here.