Naming New Worksheets During Loop

Joe_L

New Member
Joined
Mar 10, 2011
Messages
14
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Welcome to MrExcel.

Try (untested):

Rich (BB code):
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

New Member
Joined
Mar 10, 2011
Messages
14
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Does:

Selection.Rows.Count

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

Joe_L

New Member
Joined
Mar 10, 2011
Messages
14
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
So test for that and don't copy if it's True:

Code:
    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

New Member
Joined
Mar 10, 2011
Messages
14
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
That's because you are using End(xlDown). Try:

Code:
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

New Member
Joined
Mar 10, 2011
Messages
14
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
 

Forum statistics

Threads
1,082,380
Messages
5,365,124
Members
400,824
Latest member
Themilkybarkid

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top