Creating new tabs

[alopecito]

HI, I just need some help with this code: I write this code to create tabs on thsi report, according with the sales made by different companies, the problem I have is that I need to create the tabs ONLY for the companies with sales, The code actualy create a tab for every single company regardless if they have sales or not.
Thanks

[lucas]

Well, it would need some way to decide which ones made sales, I don't see anything that tells us that in your example unless I'm missing something.

[alopecito]

Thanks for your response, lets use the cell E5 (when is empty I need either to erase the tab or not to create that one),
Thanks again!

[Bob Phillips]

Try this



Sub Tabs01()

Call routine2("*Company 1*", "Company 1 Sales")
Call routine2("*Company 2*", "Company 2 Sales")
Call routine2("*Company 3*", "Company 3 Sales")
Call routine2("*Company 4*", "Company 4 Sales")
Call routine2("*Company 5*", "Company 5 Sales")
Call routine2("*Company 6*", "Company 6 Sales")
Call routine2("*Company 7*", "Company 7 Sales")
Call routine2("*Company 8*", "Company 8 Sales")
Call routine2("*Company 9*", "Company 9 Sales")
Call routine2("*Company 10*", "Company 10 Sales")

Application.CutCopyMode = False
End Sub


Function routine2(ByVal TestValue As String, ByVal nombre As String)
Dim sh As Worksheet
Dim LastRow As Long

With Worksheets("LS Sales")

LastRow = .Cells(.Rows.count, "C").End(xlUp).Row
.Rows("4:4").AutoFilter

.Cells.AutoFilter Field:=3, Criteria1:=TestValue
If .Range("C4").Resize(LastRow - 3).SpecialCells(xlCellTypeVisible).Cells.count > 4 Then

.Columns("A:H").SpecialCells(xlCellTypeVisible).Copy
Set sh = Sheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.count))
sh.Paste
sh.Name = nombre
sh.Cells.EntireColumn.AutoFit
sh.Cells.EntireRow.AutoFit
End If

.Rows("4:4").AutoFilter
End With
End Function

[Bob Phillips]

Well, it would need some way to decide which ones made sales, I don't see anything that tells us that in your example unless I'm missing something.

Anything visible after filtering that criteria Steve.

[lucas]

Bob, I was looking at his example and it had money in every cell in column E

Your code is a thing of beauty but it lumps company 1 and company 10 together.

[alopecito]

Thanks!!!

[alopecito]

There is another problem with this code, I used the Intersect comand to avoid coping the whole sheet (even the empty spaces) this code actually do that, copy and paste the whole sheet, How can I change that?
Thanks

[alopecito]

Or can I just write a code deleting the TABs created with no sales on It?

[Bob Phillips]

Your code is a thing of beauty but it lumps company 1 and company 10 together.

I noticed that, but I was keeping quiet :whistle:

[alopecito]

This is the code that is on the Example I attached before:


Sub Tabs01()

' 1st Company Tab
Rows("4:4").Select
Selection.AutoFilter

Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="*Company 1*"
routine2 ("Company 1 Sales")

Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select

Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="*Company 2*"
routine2 ("Company 2 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select


Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="*Company 3*"
routine2 ("Company 3 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select



Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="*Company 4*"
routine2 ("Company 4 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select



Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="*Company 5*"
routine2 ("Company 5 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select


Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="=*Company 6*"
routine2 ("Company 6 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit


Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="=*Company 7*"
routine2 ("Company 7 Sales")

Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select


Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="=*Company 8*"
routine2 ("Company 8 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select


Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="=*Company 9*"
routine2 ("Company 9 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select



Sheets("LS Sales").Select
Selection.AutoFilter Field:=3, Criteria1:="=*Company 10*"
routine2 ("Company 10 Sales")
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select

Rows("4:4").Select
Selection.AutoFilter



End Sub


Function routine2(nombre)
Intersect(Columns("A:h"), ActiveSheet.UsedRange).Copy
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = nombre
End Function

[Bob Phillips]

Yes it is. So what?

[Aussiebear]

Could this be a an alternative way of looking at your report