I need to use a list rather than hard coding criteria and duplicating the code

[snowbounduk]

I have some code I run on a spreadsheet, where I apply a filter to one of the columns and paste that information into another sheet.

I have to run this with different criteria in the same column to produce 13 different worksheets.

Rather than hard coding the criteria and duplicating the code. Is it possible to run a loop where the criteria comes from a list the code looks at.

Any help much appreciated.

Gordon

[vba]

Sub Backbone()
'
' Backbone Transmission
' Delete Old Stuff First
Sheets("Backbone Transmission").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireRow.Delete
Range("A1").Select
'
' This will put the relevant line in from the summary tab for this programme
' Summary Line
Sheets("Summary").Select
Range("B1").Select
Selection.AutoFilter Field:=1, Criteria1:="Backbone Transmission"

Sheets("Summary").AutoFilter.Range.Copy

Sheets("Backbone Transmission").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Slip To Left
Sheets("Slip To Left").Select
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="Backbone Transmission"

Sheets("Slip To Left").AutoFilter.Range.Copy

Sheets("Backbone Transmission").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "Slip To Left"

Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1").Select
Sheets("Slip To Left").Select
Selection.AutoFilter Field:=1
Range("C3").Select
Application.CutCopyMode = False
Sheets("Backbone Transmission").Select
Range("A1").Select
[/vba]

[Bob Phillips]

Put the criteria in an array and loop round reading the array.

[snowbounduk]

I shall google how to do just that.

Cheers.

[snowbounduk]

I have the criteria in a sheet, is there a way of looking at that list rather than entering the criteria in an array?

[Bob Phillips]

You could, but maybe just dropping it into the array at one sweep is the best way

[vba]

myArray = Range("A1:A10")
[/vba]

and then process the in-memory array

[p45cal]

I'm a bit mystified, your code, rather than "to run this with different criteria in the same column to produce 13 different worksheets" seems to be gathering info from different worksheets ('Summary' & 'Slip To Left') and pasting it into one sheet ('Backbone Transmission')

I've tried to shorten the code to help see what's going on, removing selections etc. It should then be quite easy to put it into a loop with sheets as variables. Could you confirm that I've got it right and that the following snippet does the same as your original code? I hope I haven't been too enthusiastic deleting code![vba]Sub Backbone()
' Backbone Transmission
' Delete Old Stuff First
Sheets("Backbone Transmission").Range(Range("A1"), Range("A1").End(xlDown)).EntireRow.Delete
'
' This will put the relevant line in from the summary tab for this programme
' Summary Line
Sheets("Summary").Range("B1").AutoFilter Field:=1, Criteria1:="Backbone Transmission"
Sheets("Summary").AutoFilter.Range.Copy Sheets("Backbone Transmission").Range("A1")
' Slip To Left
Sheets("Backbone Transmission").Range("A1").End(xlDown).Offset(1).Value = "Slip To Left"
Sheets("Slip To Left").Range("A1").AutoFilter Field:=1, Criteria1:="Backbone Transmission"
Sheets("Slip To Left").AutoFilter.Range.Copy Sheets("Backbone Transmission").Range("A1").End(xlDown).Offset(1)
Sheets("Slip To Left").AutoFilter Field:=1
End Sub
[/vba]

[p45cal]

Further,
1. is the Sheet 'Backbone Transmission' one of the thirteen sheets you need to produce?
2. Do the sheets all already exist?
3. Are all the sheet names exactly the same as the Criteria?
4. Are there just 2 sheets ('Summary' & 'Slip To Left') from which you'll always be gathering the info?

[snowbounduk]

Many thanks for that. I will have to try your shortened code tomorrow.

Backbone Transmission is one of the thirteen to be produced.
The sheets do already exist.
I believe the sheet names are the same as the criteria, I will check tomorrow.
There are more than summary and slip to left, there are roughly another 8 sheets to take info from.

Many thanks for looking at this. I am new to all this, what I have works but I am aware it is a very long winded way of doing it.

Thanks again.

Gordon

[p45cal]

In which case something along the lines of the following might do the trick (but check the simpler code in message #7 is correct first):[vba]Sub Backbone()
myCriteria = Array("Backbone Transmission", "Backbone Trans1", "Backbone Trans2", "Backbone Trans3", "Backbone Trans4", "Backbone Trans5")
SourceSheetNames = Array("Slip To Left", "Source2", "Source3", "Source4", "Source5", "Source6", "Source7", "Source8")
For Each Crit In myCriteria
With Sheets(Crit)
' Delete Old Stuff First
Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
'
' This will put the relevant line in from the summary tab for this programme
' Summary Line
Sheets("Summary").Range("B1").AutoFilter Field:=1, Criteria1:=Crit
Sheets("Summary").AutoFilter.Range.Copy .Range("A1")
' Slip To Left
For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).AutoFilter Field:=1
Next SourceShtNme
End With
Next Crit
End Sub
[/vba]Currently myCriteria and SourceSheetNames are hard-coded arrays. That does't have to be the case as xld indicated.

Is Summary sheet to be treated differently from the rest as a source sheet? I note that you selected B1 in it rather than A1 in the others. Perhaps the filters are only single column filters? If it doesn't need special treatment then it can be brought into the loop, but it's first line on the destination sheet will be row 2 rather than row 1. A blank top row can be deleted afterwards, or you might be happy to live with it.

[snowbounduk]

I had to make one change, adding [VBA].Range("A1")[/VBA] to [VBA]Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1[/VBA].

It works a treat now!

[VBA]Sub ATester2()
myCriteria = Array("2G", "Backbone Transmission", "Consolidation", "Deployment", "IT", "Microwave Transmission", "Operations", "Capacity", "RAN Design", "RNC And Reparenting", "IP")
SourceSheetNames = Array("Slip No Issue", "Slip With Issue", "Slip To Left", "New MS", "Deleted", "Future Complete", "Past Incomplete", "Missing", "No_Pres", "Estimated_Duration", "Overdue_Tasks")
For Each Crit In myCriteria
With Sheets(Crit)
' Delete Old Stuff First
Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
'
' This will put the relevant line in from the summary tab for this programme
' Summary Line
Sheets("Summary").Range("B1").AutoFilter Field:=1, Criteria1:=Crit
Sheets("Summary").AutoFilter.Range.Copy .Range("A1")
' Slip To Left
For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1
Next SourceShtNme
End With
Next Crit
End Sub[/VBA]

I have tried incorporating Summary into the array with the following but get a blah blah error:

[VBA]Sub ATester3()
myCriteria = Array("2G", "Backbone Transmission", "Consolidation", "Deployment", "IT", "Microwave Transmission", "Operations", "Capacity", "RAN Design", "RNC And Reparenting", "IP")
SourceSheetNames = Array("Summary", "Slip No Issue", "Slip With Issue", "Slip To Left", "New MS", "Deleted", "Future Complete", "Past Incomplete", "Missing", "No_Pres", "Estimated_Duration", "Overdue_Tasks")
For Each Crit In myCriteria
With Sheets(Crit)
' Delete Old Stuff First
Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete

For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=1
Next SourceShtNme
End With
Next Crit
End Sub[/VBA]

I will keep trying to get it working.

Thanks again for simplifying my rather long code!

[snowbounduk]

Was the error, not blah blah error!

[snowbounduk]

Application-defined or object-defined error on line

[VBA].Range("A1").End(xlDown).Offset(1).Value = SourceShtNme[/VBA]

[p45cal]

re:"I have tried incorporating Summary into the array with the following but get a blah blah error:"
Well, in that case, it looks as if it should be treated differently from the other sheets as per my last paragraph in message #9 of this thread. Leave it out of the loop, it's no great cost.

[snowbounduk]

I've left it in and it works OK.
I am running the same code but for autofield two with a change to the criteria. These sheets do not require the summary table at the top.

The offset in the first line of the code below is causing me problems though:

[VBA]For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=2, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=2[/VBA]

Any suggestions?

[snowbounduk]

I have tried the following but am getting random data on each of the sheets

[VBA]Sub ATester5ProjectStuff()
myCriteria = Range("AA2:AA95")
SourceSheetNames = Array("Slip No Issue", "Slip With Issue", "Slip To Left", "New MS", "Deleted", "Future Complete", "Past Incomplete", "No_Pres", "Estimated_Duration", "Overdue_Tasks")
For Each Crit In myCriteria
With Sheets(Crit)
' Delete Old Stuff First
Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
.Range("A2").Value = "Project Summary"
' This will put the relevant line in from the summary tab for this programme
' Summary Line
'Sheets("Summary").Range("A1").AutoFilter Field:=1, Criteria1:=Crit2
'Sheets("Summary").AutoFilter.Range.Copy .Range("A1")
'Sheets("Summary").Range("A1").AutoFilter Field:=2
For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=2, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).Range("A1").AutoFilter Field:=2
Next SourceShtNme
End With
Next Crit
End Sub[/VBA]

[p45cal]

This is happening when SourceShtNme is Summary, and/or it's the first copy to the destination sheet, which is blank? If you select A1 on a blank sheet then on the keyboard, press End and DownArrow, it will take you to the bottom of the sheet. Not good. Either take Summary out of the loop or change the way it finds the first empty row.
Change:

.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme

to:

.cells(.rows.count,1).end(xlup).Offset(1).Value = SourceShtNme

and:

Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)

to:

Sheets(SourceShtNme).AutoFilter.Range.Copy .cells(.rows.count,1).end(xlup).Offset(1)

This now effectively does the same as sellecting the very bottom cell of the sheet in column A and pressing End then UpArrow on the keyboard.

But I reiterate, perhaps Summary sheet is different enough not to include it in the loop. You're making extra work for yourself.

[p45cal]

myCriteria = Range("AA2:AA95")
You have a lot of sheets to make!

[snowbounduk]

The first code was breaking the information down into programmes, the second lot is breaking it down into projects. There are a lot of projects! (each programme has several projects)

The summary sheet only contains programme information, so I cannot include it in the project sheets.

I have got it working by adding two lines to the top of each report, Project Summary.

Next I am going to change the code for emailing the reports to looking at a list of email addresses against programmes. My current code is again long winded and repetative!

Thanks again.

[VBA]Sub ATester5ProjectStuff()
myCriteria = Range("AA2:AA95")
SourceSheetNames = Array("Slip No Issue", "Slip With Issue", "Slip To Left", "New MS", "Deleted", "Future Complete", "Past Incomplete", "No_Pres", "Estimated_Duration", "Overdue_Tasks")
For Each Crit In myCriteria
With Sheets(Crit)
' Delete Old Stuff First
Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
.Range("A1").Value = "Project"
.Range("A2").Value = "Summary"
' This will put the relevant line in from the summary tab for this programme
' Summary Line
'Sheets("Summary").Range("A1").AutoFilter Field:=1, Criteria1:=Crit2
'Sheets("Summary").AutoFilter.Range.Copy .Range("A1")
'Sheets("Summary").Range("A1").AutoFilter Field:=2
For Each SourceShtNme In SourceSheetNames
.Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
Sheets(SourceShtNme).Range("B1").AutoFilter Field:=2, Criteria1:=Crit
Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
Sheets(SourceShtNme).Range("B1").AutoFilter Field:=2
Next SourceShtNme
End With
Next Crit
End Sub[/VBA]