HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Perform loop through process on all sheets at once

Submitted by: @import:stackexchange-codereview··
0
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:

Solution

I'll take a crack at this. First things first - always qualify where you're doing something e.g. 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
    Next


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 .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
         Next


This 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 be


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 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 ScreenUpdating

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


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 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
    Next
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
         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.