patternMinor
Perform loop through process on all sheets at once
Viewed 0 times
onceprocessallloopperformthroughsheets
Problem
I have workbook having multiple sheets and having same data on it. Currently I am using macro that .autofilterand copy paste on respective sheets. I am using looping process like:-
```
Sub SCRIPT()
Application.ScreenUpdating = False
Sheets("SCRIPT").Range("A3:P100").ClearContents
Dim ws As Worksheet, lrc As Long, LR1 As Long, LR2 As Long
Dim key1 As String
key1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
ws.Range("AE1:AJ500").ClearContents
ws.Range("CB1:CH500").ClearContents
ws.Range("A1").AutoFilter Field:=1, Criteria1:=key1
ws.Range("A1").AutoFilter Field:=2, Criteria1:="28-Jan-16"
lrc = ws.Range("D" & Rows.Count).End(xlUp).Row
ws.Range("D1:D" & lrc).AutoFilter Field:=4, Criteria1:="CE"
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AG2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AE2")
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CD2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CB2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AH2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AJ2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CH2")
ws.Range("M2:M" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CF2")
AutoFilterMode = False
ws.Range("D1:D" & lrc).AutoFilter Field:=4, Criteria1:="PE"
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AF2")
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CC2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AI2")
ws.Range("I2:
```
Sub SCRIPT()
Application.ScreenUpdating = False
Sheets("SCRIPT").Range("A3:P100").ClearContents
Dim ws As Worksheet, lrc As Long, LR1 As Long, LR2 As Long
Dim key1 As String
key1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
ws.Range("AE1:AJ500").ClearContents
ws.Range("CB1:CH500").ClearContents
ws.Range("A1").AutoFilter Field:=1, Criteria1:=key1
ws.Range("A1").AutoFilter Field:=2, Criteria1:="28-Jan-16"
lrc = ws.Range("D" & Rows.Count).End(xlUp).Row
ws.Range("D1:D" & lrc).AutoFilter Field:=4, Criteria1:="CE"
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AG2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AE2")
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CD2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CB2")
ws.Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AH2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AJ2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CH2")
ws.Range("M2:M" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CF2")
AutoFilterMode = False
ws.Range("D1:D" & lrc).AutoFilter Field:=4, Criteria1:="PE"
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AF2")
ws.Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("CC2")
ws.Range("I2:I" & lrc).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("AI2")
ws.Range("I2:
Solution
I'll take a crack at this. First things first - always qualify where you're doing something e.g.
Your variable names are lacking -
You're clearing out
Your indentation is difficult to follow, your for loops and if blocks should be offset like this -
It makes it a lot easier to read. You can actually indent several lines in the VBE by highlighting and hitting Tab.
When you're working with all those
This will make it less cluttered. You should also use some comments to explain why things are happening -
Speaking of your autofilters why not
Now you don't have to go into the code to find it.
The same goes for your second criteria, why not give those variables at the top as strings and then use the variables, that way if anything changes you can just change it at the top.
In your second
Personally I don't like all the
This has the added benefit that if you want to change the worksheets within your
Also what's up with this -
The second one negates the first one, or are you just making sure nothing is still selected on those sheets? Nothing should be
If you need some more speed try doing these along with
Just remember to turn them back on when you're finished.
One more thing, I don't see any error handling, what happens if there's an error? It will stop and you'll need to loop through all the sheets again once it's fixed.
Oh - also use
AutoFilterMode = False should be ws.AutoFilterMode = False.Your variable names are lacking -
lrc, LR1 and LR2 give me no idea as to what they are being used for or if they are different from one another. Same goes for key1 - it's for a "Script Name" according to the inputbox, so why not name is ScriptName or ScriptNameKey? And ws as Worksheet, why not say MyWorksheet or CurrentWorksheet?You're clearing out
Sheets("SCRIPT") but I don't know why, I don't see anything going back to it.Your indentation is difficult to follow, your for loops and if blocks should be offset like this -
key1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
ws.Range("AE1:AJ500").ClearContents
ws.Range("CB1:CH500").ClearContents
End If
NextIt makes it a lot easier to read. You can actually indent several lines in the VBE by highlighting and hitting Tab.
When you're working with all those
.Range elements, you can use a With block -key1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
With ws
.Range("AE1:AJ500").ClearContents
.Range("P1").AutoFilter
End With
End If
NextThis will make it less cluttered. You should also use some comments to explain why things are happening -
'These ranges need to be cleared to ensure the formatting of xxx doesn't change as it reaches the destination
.Range("AE1:AJ500").ClearContents
.Range("CB1:CH500").ClearContents
'We filter on these two criteria because that allows ....
.Range("A1").AutoFilter Field:=1, Criteria1:=key1
.Range("A1").AutoFilter Field:=2, Criteria1:="28-Jan-16"Speaking of your autofilters why not
Dim FilterDate as Date
FilterDate = Now() 'or whatever the date needs to beNow you don't have to go into the code to find it.
The same goes for your second criteria, why not give those variables at the top as strings and then use the variables, that way if anything changes you can just change it at the top.
In your second
If block you are moving between ws and two defined sheets. Why not give those sheets a variable as well?Personally I don't like all the
.Copy Destination methods. I like to work directly with the locations like this -.Range("AG2") = .Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible)
.Range("AE2") = .Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible)
.Range("CD2") = .Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible)This has the added benefit that if you want to change the worksheets within your
If block, you can just slap on a sheet variable.Also what's up with this -
Application.Goto (ActiveWorkbook.Sheets("SCRIPT").Range("A1"))
Application.Goto (ActiveWorkbook.Sheets("CHAIN").Range("A1"))The second one negates the first one, or are you just making sure nothing is still selected on those sheets? Nothing should be
.Selected anyway.If you need some more speed try doing these along with
ScreenUpdatingApplication.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = FalseJust remember to turn them back on when you're finished.
One more thing, I don't see any error handling, what happens if there's an error? It will stop and you'll need to loop through all the sheets again once it's fixed.
Oh - also use
Option Explicit on the top, you may have caught some of the things I mentioned just by compiling with that engaged.Code Snippets
key1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
ws.Range("AE1:AJ500").ClearContents
ws.Range("CB1:CH500").ClearContents
End If
Nextkey1 = InputBox("Type Script Name", "Title")
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "SCRIPT") And (ws.Name <> "MARKET") And (ws.Name <> "CHAIN") Then
With ws
.Range("AE1:AJ500").ClearContents
.Range("P1").AutoFilter
End With
End If
Next'These ranges need to be cleared to ensure the formatting of xxx doesn't change as it reaches the destination
.Range("AE1:AJ500").ClearContents
.Range("CB1:CH500").ClearContents
'We filter on these two criteria because that allows ....
.Range("A1").AutoFilter Field:=1, Criteria1:=key1
.Range("A1").AutoFilter Field:=2, Criteria1:="28-Jan-16"Dim FilterDate as Date
FilterDate = Now() 'or whatever the date needs to be.Range("AG2") = .Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible)
.Range("AE2") = .Range("C2:C" & lrc).SpecialCells(xlCellTypeVisible)
.Range("CD2") = .Range("L2:L" & lrc).SpecialCells(xlCellTypeVisible)Context
StackExchange Code Review Q#116874, answer score: 3
Revisions (0)
No revisions yet.