How to loop code that moves to next column at end and loops again, over several columns

[skeeeter56]

I have a button when clicked runs some code which works perfect. What I want to do is when the code ends to move to next column and run again

Private Sub cbPrintUMS1_Click() Application.ScreenUpdating = False ' Get the worksheets Dim shRead As Worksheet Set shGroup1 = ThisWorkbook.Worksheets("Nunawading") Set shGroup2 = ThisWorkbook.Worksheets("Vermont") Set shGroup3 = ThisWorkbook.Worksheets("Mitcham") Set shGroup4 = ThisWorkbook.Worksheets("Blackburn") Set shGroup5 = ThisWorkbook.Worksheets("Box Hill 1") Set shGroup6 = ThisWorkbook.Worksheets("Box Hill 2") Set shData = ThisWorkbook.Worksheets("Week Commencing") 'Group1 If shData.Range("C20") = True Then ' This will copy to Nunawading Sheet shData.Range("Nuna1").Copy shGroup1.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup1.PrintPreview End If 'Group2 If shData.Range("C30") = True Then ' This will copy to Vermont Sheet shData.Range("Verm1").Copy shGroup2.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup2.PrintPreview End If 'Group3 If shData.Range("C40") = True Then ' This will copy to Mitcham Sheet shData.Range("Mitch1").Copy shGroup3.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup3.PrintPreview End If 'Group4 If shData.Range("C55") = True Then ' This will copy to Blackurn Sheet shData.Range("Black1").Copy shGroup4.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup4.PrintPreview End If 'Group5 If shData.Range("C74") = True Then ' This will copy to Box Hill 1 Sheet shData.Range("Boxh1").Copy shGroup5.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup5.PrintPreview End If 'Group6 If shData.Range("C75") = True Then ' This will copy to Box Hill 2 shData.Range("Boxhi1").Copy shGroup6.Range("D6").PasteSpecial , Paste:=xlPasteValues, Transpose:=True shGroup6.PrintPreview End If shGroup1.Range("Clear1").ClearContents shGroup2.Range("Clear2").ClearContents shGroup3.Range("Clear3").ClearContents shGroup4.Range("Clear4").ClearContents shGroup5.Range("Clear5").ClearContents shGroup6.Range("Clear6").ClearContents Application.ScreenUpdating = True End Sub

This is the Main page the rows 20,30,40,55,74 and 75 from C to P each cell has this formula =SUMPRODUCT(ISTEXT(Nuna1)+ISNUMBER(Nuna1))>0 this example checks C9:C18 to see if it contains a value gives True or False
Each Range for example in Row C20 Nuna1, D20 Nuna2 up to P20 Nuna14.
The same format is used for the other groups as it moves down the page.
Verm1 to Verm14, Mitch1 to Mitch14, Black1 to Black14, Boxh1 to Boxh14, Boxhi1 to Boxhi14

I have tried various ways to achieve but as yet have not bee able to master it. If anyone is able to help be most grateful

 

[DanteAmor]

I'm not understanding.
Do you want to modify the original macro?
Or modify the macro that you put in post #6?
Or am I going to modify each of the macro that you have in each new button?
If now you want to write on a sheet but in 5 different columns, then I suggest you create a new thread and present the new problem.

 

[skeeeter56]

The macro you provided works perfectly, and this is what will be used most times. Your code loops through each to see a condition is true and if so copies values to a sheet for each group and prints, works perfectly.
These sheets have the data from only 1 range (Nuna1, Nuna2) etc per sheet.
The exception to this is when I want all the ranges Nuna1 to Nuna14 for example to print on 1 sheet. I thought the code would only need some slight changes, I have tried and have managed to get some of what I want but bit lost really
I have added a a value in row 6 Column C to P with numbers that come form clicking the coloured buttons. This also allows to conditional format the color of text based on this number.
It also is used when it contains a value of 2 this formula =IF(C6<>2,SUMPRODUCT(ISTEXT(Nuna2)+ISNUMBER(Nuna1))>0) to change the Value at Nuna1 etc to False so the original code does not print these entries.
I have also named some more ranges for C8 to C9 as Name1 to Name14 also C9 to C14 as Code1 to Code14
I am not sure if they are needed or not as only 1 row

testing UMS.xlsm
	A	B	C	D
6			1	2
7			2
8	Group 1	Total Pri.	Name1	Name2
9			Code1	Code2
10	2	458	536	123
11	3	846	789	7
12	4	785	1000	5
13	5	850		9
14	6	786	653	25
15	7	823	963	68
16	8	202
17	9	808
18	10	900
19	Boxes	34
20			3941	237
21	SUMPRODUCT(ISTEXT(Verm1)+ISNUMBER(Nuna1))>0		TRUE	FALSE
Week Commencing

Cell Formulas
Range	Formula
C20:D20	C20	=SUM(C10:C19)
C21	C21	=IF(C6<>2,SUMPRODUCT(ISTEXT(Nuna2)+ISNUMBER(Nuna1))>0)
D21	D21	=IF(D6<>2,SUMPRODUCT(ISTEXT(Nuna2)+ISNUMBER(Nuna2))>0)

Named Ranges
Name	Refers To	Cells
Nuna1	='Week Commencing'!$C$10:$C$19	C20:C21
Nuna2	='Week Commencing'!$D$10:$D$19	C21:D21, D20

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29	Expression	=$D$6=5	text	NO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29	Expression	=$D$6=4	text	NO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29	Expression	=$D$6=3	text	NO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29	Expression	=$D$6=2	text	NO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29	Expression	=$D$6=1	text	NO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29	Expression	=$C$6=5	text	NO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29	Expression	=$C$6=4	text	NO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29	Expression	=$C$6=3	text	NO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29	Expression	=$C$6=2	text	NO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29	Expression	=$C$6=1	text	NO

This is the sheet where I want the data, I have typed what I what I want where. These 5 sheets 1 for each group I am thinking would need this line changed
arrSh = Array("Nunawading", "Vermont", "Mitcham", "Blackburn", "Box Hill 1", "Box Hill 2")
to
arrSh = Array("Nunawading Bus", "Vermont Bus", "Mitcham Bus", "Blackburn Bus", "Box Hill Bus")

I can get the origianl code to copy the shData.Range(arrRn(i) & k).Copy lr = 7 shGroup.Range("D6").PasteSpecial Paste:=xlPasteValues
By removing the Transpose.
But thinking that we only need to check the value in Row 6 Column C to P if it equals 2 it the copies and prints.
I hope this makes abit more sense, I really do appreciate your help

 

[DanteAmor]

I'm lost. You already have a macro and it works. But you want another macro that does similar things.
You could create a new thread.

 

[skeeeter56]

I'm lost. You already have a macro and it works. But you want another macro that does similar things.
You could create a new thread.

Ok sorry yes is hard to explain, just thought would only need a few things changed in the one you have already done. What you have provided is fantastic. I will dabble with your code that will be seperatly on another button to see if I can get it there. If no luck will create another thread. Once again a huge thanks