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

skeeeter56

New Member
Joined
Nov 26, 2016
Messages
25
Office Version
  1. 2019
Platform
  1. Windows
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


Capture.JPG


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

Well-known Member
Joined
Dec 3, 2018
Messages
14,165
Office Version
  1. 2007
Platform
  1. Windows
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.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

skeeeter56

New Member
Joined
Nov 26, 2016
Messages
25
Office Version
  1. 2019
Platform
  1. Windows
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
ABCD
612
72
8Group 1Total Pri.Name1Name2
9Code1Code2
102458536123
1138467897
12478510005
1358509
14678665325
15782396368
168202
179808
1810900
19Boxes34
203941237
21SUMPRODUCT(ISTEXT(Verm1)+ISNUMBER(Nuna1))>0TRUEFALSE
Week Commencing
Cell Formulas
RangeFormula
C20:D20C20=SUM(C10:C19)
C21C21=IF(C6<>2,SUMPRODUCT(ISTEXT(Nuna2)+ISNUMBER(Nuna1))>0)
D21D21=IF(D6<>2,SUMPRODUCT(ISTEXT(Nuna2)+ISNUMBER(Nuna2))>0)
Named Ranges
NameRefers ToCells
Nuna1='Week Commencing'!$C$10:$C$19C20:C21
Nuna2='Week Commencing'!$D$10:$D$19C21:D21, D20
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29Expression=$D$6=5textNO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29Expression=$D$6=4textNO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29Expression=$D$6=3textNO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29Expression=$D$6=2textNO
D10:D19,D33:D39,D43:D54,D59:D74,D23:D29Expression=$D$6=1textNO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29Expression=$C$6=5textNO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29Expression=$C$6=4textNO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29Expression=$C$6=3textNO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29Expression=$C$6=2textNO
C10:C19,C33:C39,C43:C54,C59:C74,C23:C29Expression=$C$6=1textNO


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")
cap7.JPG

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

Well-known Member
Joined
Dec 3, 2018
Messages
14,165
Office Version
  1. 2007
Platform
  1. Windows
:unsure: 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

New Member
Joined
Nov 26, 2016
Messages
25
Office Version
  1. 2019
Platform
  1. Windows
:unsure: 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 (y)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,839
Messages
5,766,725
Members
425,374
Latest member
EgleA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top