• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Looping macro help

harrisrs24370

New Member
Hello...can anyone help me figure out what I need to add to this macro in order to loop it across multiple worksheets? Here's my macro:


Sub CouponTest()

'

' CouponTest Macro

'

' Keyboard Shortcut: Ctrl+x

'

Sheets(Array("605", "606", "607", "608")).Select

Sheets("605").Activate

ActiveWindow.SmallScroll Down:=-9

Range("F13").Select

Sheets("605").Select

Range("D1").Select

ActiveWindow.SmallScroll Down:=162

Range("D166").Select

ActiveWindow.SmallScroll Down:=-183

Range("D1").Select

ActiveCell.FormulaR1C1 = "Desc"

Range("A1:H179").Select

ActiveWindow.SmallScroll Down:=-171

ActiveWorkbook.Worksheets("605").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("605").Sort.SortFields.Add Key:=Range("D2:D179"), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("605").Sort

.SetRange Range("A1:H179")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveWindow.SmallScroll Down:=-3

Range("A1").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _

Replace:=True, PageBreaks:=False, SummaryBelowData:=True

ActiveWindow.SmallScroll Down:=-87

ActiveWindow.ScrollRow = 55

ActiveWindow.ScrollRow = 53

ActiveWindow.ScrollRow = 47

ActiveWindow.ScrollRow = 39

ActiveWindow.ScrollRow = 31

ActiveWindow.ScrollRow = 23

ActiveWindow.ScrollRow = 20

ActiveWindow.ScrollRow = 17

ActiveWindow.ScrollRow = 14

ActiveWindow.ScrollRow = 12

ActiveWindow.ScrollRow = 10

ActiveWindow.ScrollRow = 9

ActiveWindow.ScrollRow = 7

ActiveWindow.ScrollRow = 6

ActiveWindow.ScrollRow = 5

ActiveWindow.ScrollRow = 4

ActiveWindow.ScrollRow = 3

ActiveWindow.ScrollRow = 2

ActiveWindow.ScrollRow = 1

Range("D4").Select

Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(8), _

Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Range("C11").Select

ActiveSheet.Outline.ShowLevels RowLevels:=2

Range("D48").Select

ActiveWindow.SmallScroll Down:=-21

Columns("A:C").Select

Range("C1").Activate

Selection.EntireColumn.Hidden = True

Columns("E:G").Select

Range("E2").Activate

Selection.EntireColumn.Hidden = True

Range("L26").Select

Columns("D:D").EntireColumn.AutoFit

Range("J58").Select

End Sub
 
Wrap the following around what you want to do.

Note you should clean up your macro by taking out all the code that reltaes to your moving around the sheets.


Dim xArray(4) '. number of sheets


xArray(1) = "605"

xArray(2) = "606"

xArray(3) = "607"

xArray(4) = "608"


For x = 1 To 4 ' number of sheets


Sheets(xArray(x)).Select


'YOUR CODE HERE


Next x
 
Thanks for your help. Please bare with me...I'm very new to macros. I included your commands, but when I run the macro it still only formats the first sheet ("605"). I'm sure there's something I've done wrong. Here's what I have now:


Sub CouponTest()

'

' CouponTest Macro

'

' Keyboard Shortcut: Ctrl+x

'

Dim xArray(4) '.number of sheets


xArray(1) = "605"

xArray(2) = "606"

xArray(3) = "607"

xArray(4) = "608"


For x = 1 To 4 'number of sheets


Sheets(xArray(x)).Select

Sheets(Array("605", "606", "607", "608")).Select

Sheets("605").Activate

ActiveWindow.SmallScroll Down:=-9

Range("F13").Select

Sheets("605").Select

Range("D1").Select

ActiveWindow.SmallScroll Down:=162

Range("D166").Select

ActiveWindow.SmallScroll Down:=-183

Range("D1").Select

ActiveCell.FormulaR1C1 = "Desc"

Range("A1:H179").Select

ActiveWindow.SmallScroll Down:=-171

ActiveWorkbook.Worksheets("605").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("605").Sort.SortFields.Add Key:=Range("D2:D179"), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("605").Sort

.SetRange Range("A1:H179")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveWindow.SmallScroll Down:=-3

Range("A1").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _

Replace:=True, PageBreaks:=False, SummaryBelowData:=True

ActiveWindow.SmallScroll Down:=-87

ActiveWindow.ScrollRow = 55

ActiveWindow.ScrollRow = 53

ActiveWindow.ScrollRow = 47

ActiveWindow.ScrollRow = 39

ActiveWindow.ScrollRow = 31

ActiveWindow.ScrollRow = 23

ActiveWindow.ScrollRow = 20

ActiveWindow.ScrollRow = 17

ActiveWindow.ScrollRow = 14

ActiveWindow.ScrollRow = 12

ActiveWindow.ScrollRow = 10

ActiveWindow.ScrollRow = 9

ActiveWindow.ScrollRow = 7

ActiveWindow.ScrollRow = 6

ActiveWindow.ScrollRow = 5

ActiveWindow.ScrollRow = 4

ActiveWindow.ScrollRow = 3

ActiveWindow.ScrollRow = 2

ActiveWindow.ScrollRow = 1

Range("D4").Select

Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(8), _

Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Range("C11").Select

ActiveSheet.Outline.ShowLevels RowLevels:=2

Range("D48").Select

ActiveWindow.SmallScroll Down:=-21

Columns("A:C").Select

Range("C1").Activate

Selection.EntireColumn.Hidden = True

Columns("E:G").Select

Range("E2").Activate

Selection.EntireColumn.Hidden = True

Range("L26").Select

Columns("D:D").EntireColumn.AutoFit

Range("J58").Select

Next x


End Sub
 
Replace all

Sheets("605")

with

Sheets(xArray(x))


and


Worksheets("605")

with

Worksheets(xArray(x))


and delete the line

Sheets(Array("605", "606", "607", "608")).Select
 
harrisrs,


Not a direct answer to your first question, but a general tip on macro writing:

All of the ActiveWindow.ScrollRow lines can be deleted. That's simply telling the workbook to scroll to a certain row, which only affects visuals. It might actually make the user slightly dizzy watching all that.


Additionally, you should probably put the line:

Application.ScreenUpdating = False


At the beginning of your code. This tells XL to not update the screen until the code finishes. Benefits are no more "flashing screen", and code runs MUCH faster (sometimg 10x)
 
So long as you put a

Application.ScreenUpdating = True

line at the end
 
Hui,

While I admit it makes for "good" coding practice to reset the screenupdating at the end, is it really necessary? I've seen both methods used in coding, and it appears that the screen updating resets after the code has finished running.

Care to enlighten/teach on the issue?
 
Back
Top