Autofilter several sheets with multiple criteria to create new sheets from list

[snowbounduk]

Hello All,

I have the following code which I use to run through a number of sheets (SourceSheetNames), apply a filter, using criteria from MyCriteria and paste to worksheets, named as per the criteria.

I would like to do two things.

1. Change the field number for certain sheets
2. Add a second criteria to certain sheets.

Any help would be most appreciated!

Sub ACreateProjectReportsIncDps()

    myCriteria = Sheets("Recd Plans").Range("C2:C159")
    SourceSheetNames = Array("Slip No Issue", "Slip No Issue PP2", "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)
            Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
            .Range("A1").Value = "Project"
            .Range("A2").Value = "Summary"
            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

 

[baitmaster]

Sounds to me like your best approach would be to use a SELECT statement
something like:

            For Each SourceShtNme In SourceSheetNames
                select case crit
                    case "sheet1"
                        .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
                    case "sheet2"
                        ' similar code to above
                    case else
                        ' similar code to above
                end select
            Next SourceShtNme

 

[snowbounduk]

Thanks for that, my Else/If statements were giving some strange results!

I have tried the code as below but all I get on each sheet is Project & RAID in A1 and A2. I can't see where it is going wrong.... any suggestions?

Sub ACreateIssuesSummary()

    myCriteria = Sheets("Macros").Range("A2:A159")
    SourceSheetNames = Array("Risks", "Issues", "Risks", "Assumptions", "Dependencies", "Constraints", "Lessons")
    'SourceSheetNames2 = "Dependencies"
    For Each crit In myCriteria
        With Sheets(crit)
            Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
            .Range("A1").Value = "Project"
            .Range("A2").Value = "RAID"
            For Each SourceShtNme In SourceSheetNames
                Select Case crit
                
                Case "Risks"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Risks").Range("B1").AutoFilter Field:=6, Criteria1:=crit
                Sheets("Risks").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Risks").Range("B1").AutoFilter Field:=6
                
                Case "Issues"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Issues").Range("B1").AutoFilter Field:=10, Criteria1:=crit
                Sheets("Issues").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Issues").Range("B1").AutoFilter Field:=10
                
                Case "Dependencies"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Dependencies").Range("B1").AutoFilter Field:=3, Criteria1:=crit
                Sheets("Dependencies").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Dependencies").Range("B1").AutoFilter Field:=3
                Case "Assumptions"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Assumptions").Range("B1").AutoFilter Field:=4, Criteria1:=crit
                Sheets("Assumptions").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Assumptions").Range("B1").AutoFilter Field:=4
                Case "Constraints"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Constraints").Range("B1").AutoFilter Field:=4, Criteria1:=crit
                Sheets("Constraints").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Constraints").Range("B1").AutoFilter Field:=4
                Case "Lessons"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets("Lessons").Range("B1").AutoFilter Field:=3, Criteria1:=crit
                Sheets("Lessons").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets("Lessons").Range("B1").AutoFilter Field:=3
                
                End Select
            Next SourceShtNme
        End With
    Next crit

 

[baitmaster]

You're not declaring your objects and variables particularly well, which probably isn't helping, but I can't see anything that is specifically going wrong - but its difficult without seeing the whole sheet

1) use "option explicit" at the top of every code module, this will force you to declare your variables and assign them correctly. It will help identify certain types of problems

2) to write this code automatically, in VBA go to TOOLS > OPTIONS [require variable declaration]

3) because of your WITH statement, you probably shouldn't need to state sheets("RISKS") etc, just use .Range(...)

use break points and F8 to step through the code and see what it is actually doing, and msgbox to report the variables at different stages if required

 

[snowbounduk]

Thanks for that.

I've attempted to set some variables but still have a problem with

For Each Crit In myCriteria

where Crit is highlighted as Compile Error: Variable not defined.

Any suggestions welcome!

Option Explicit
Sub ACreateIssuesSummary()
Dim myCriteria As Range
Dim SourceSheetNames As Range
Dim SourceShtNme As Range
 

    myCriteria = Sheets("Macros").Range("A2:A159")
    SourceSheetNames = Array("Risks", "Issues", "Risks", "Assumptions", "Dependencies", "Constraints", "Lessons")
    For Each Crit In myCriteria
        With Sheets(Crit)
            Range(.Range("A1"), .Range("A1").End(xlDown)).EntireRow.Delete
            .Range("A1").Value = "Project"
            .Range("A2").Value = "RAID"
            For Each SourceShtNme In SourceSheetNames
                Select Case Crit
                
                Case "Risks"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=6, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=6
                
                Case "Issues"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=10, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=10
                
                Case "Dependencies"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=3, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=3
                Case "Assumptions"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=4, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=4
                Case "Constraints"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=4, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=4
                Case "Lessons"
                .Range("A1").End(xlDown).Offset(1).Value = SourceShtNme
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=3, Criteria1:=Crit
                Sheets(SourceShtNme).AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                Sheets(SourceShtNme).Range("B1").AutoFilter Field:=3
                
                End Select
            Next SourceShtNme
        End With
    Next Crit
  
    'For Each Crit In myCriteria
        'With Sheets(Crit)
                '.Range("A1").End(xlDown).Offset(1).Value = "Dependencies listed on other projects"
                'Sheets("Dependencies2").Range("A1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlAnd
                'Sheets("Dependencies2").AutoFilter.Range.Copy .Range("A1").End(xlDown).Offset(1)
                'Sheets("Dependencies2").Range("A1").AutoFilter Field:=3
        'End With
    'Next Crit
    
End Sub

 

[baitmaster]

You need to declare crit as a range, because you want it looking at each cell in a range of cells. This means you can't use it as a sheet name, so you need to assign a text string too

you'll need various other changes in your code based on these changes, e.g. using some of the following:

dim crit as range
dim strCrit as string

for each crit in ...
strCrit = crit.value

with sheets(strCrit)

select case strCrit

etc