Naming New Worksheets During Loop

[Joe_L]

Hi all - below is a loop that cycles through 10 "check" columns in a spreadsheet named "Template", selects the "check" item in the filter for each column, and pastes the results to a new spreadsheet for all 10 checks (10 new worksheets). What's driving me crazy is trying to figure out a way to name each new tab based on the column heading of each check. This would be range(CG1:CP1). Is there anyway to add in this range to my code and insert a naming command after "worksheets.add"? Right now it appears as "sheet1", "sheet2", "sheet3", etc. Thanks so much for any help

Sub Data_Check_Report()
Application.ScreenUpdating = False
Dim LastCol As Integer
Dim c As Integer
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 85 To LastCol
ActiveSheet.Range("A:$CP").AutoFilter Field:=c, Criteria1:="CHECK"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets.Add
ActiveSheet.Paste
Columns("A:CP").EntireColumn.AutoFit
Sheets("Template").Select
ActiveSheet.Range("A:CP").AutoFilter Field:=c
Next c

Application.ScreenUpdating = True
End Sub

 

[Andrew Poulsom]

Welcome to MrExcel.

Try (untested):

Sub Data_Check_Report()
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    Application.ScreenUpdating = False
    Dim LastCol As Integer
    Dim c As Integer
    LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
    For c = 85 To LastCol
        ActiveSheet.Range("A:$CP").AutoFilter Field:=c, Criteria1:="CHECK"
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sh.Cells(1, c).Value
        Columns("A:CP").EntireColumn.AutoFit
        Sheets("Template").Select
        ActiveSheet.Range("A:CP").AutoFilter Field:=c
    Next c
    Application.ScreenUpdating = True
End Sub

 

[Joe_L]

Perfect. Thanks so much.

- Joe

 

[Joe_L]

if I may just ask one more quick question, I just noticed that at times there are some columns where the filter criteria never equals "CHECK".

Is there a way to ammend the above code so that I can exclude those columns from the loop?

I've been toying around with various ideas but can't get it to execute correctly. thanks again-

 

[Andrew Poulsom]

Does:

Selection.Rows.Count

return 1 when there are no items that meet the criteria?

 

[Joe_L]

Yes - and when the below code tries to execute the copy and paste function, it selects far too many rows and causes me to receive a "excel cannot complete task with available resources" message.

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

 

[Andrew Poulsom]

So test for that and don't copy if it's True:

    If Selection.Rows.Count > 1 Then
        Selection.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sh.Cells(1, c).Value
        Columns("A:CP").EntireColumn.AutoFit
        Sheets("Template").Select
    End If

 

[Joe_L]

Thanks for the idea. Seems like it should work but unfortunitely even though there is only one row of headers when no criteria is present, it looks to be selecting a huge number of blank rows. Conversly when I try to write as:

If Selection.Rows.Count < 500

I still get the same result. Maybe because the rows are all completely blank?

 

[Andrew Poulsom]

That's because you are using End(xlDown). Try:

Sub Data_Check_Report()
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    Application.ScreenUpdating = False
    Dim LastCol As Integer
    Dim c As Integer
    LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
    For c = 85 To LastCol
        With ActiveSheet.Range("A1").CurrentRegion
            .AutoFilter Field:=c, Criteria1:="CHECK"
            If .SpecialCells(xlCellTypeVisible).Cells.Count > .Columns.Count Then
                .Copy
                Worksheets.Add
                ActiveSheet.Paste
                ActiveSheet.Name = Sh.Cells(1, c).Value
                Columns("A:CP").EntireColumn.AutoFit
                Sheets("Template").Select
            End If
            .AutoFilter Field:=c
        End With
    Next c
    Application.ScreenUpdating = True
End Sub

 

[Joe_L]

Wow, works exactly how I was picturing. Thanks very much for the help as I would not have known how to write that. thanks again.

- Joe