I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Paulo,

You need to select a single cell within your contiguous database (no blank rows or columns) prior to
running the code.

HTH,
Bernie
MS Excel MVP


"Paulo" wrote in message
...
Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

thanks again Bernie.

for now I am runing on the simpliest DB i could make. it is just as I
described, I have no blank row, or headers or any thing. just those 7 rows
with couple fruits randomly distributed . and i repet some fruits. thats it.
A , B
1,grape 7
2,grape 5
3,apple 6
4,apple 4
5,melon 5
6,pineapple 7
7,grape 15

just like that



"Bernie Deitrick" wrote:

Paulo,

You need to select a single cell within your contiguous database (no blank rows or columns) prior to
running the code.

HTH,
Bernie
MS Excel MVP


"Paulo" wrote in message
...
Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Assuming the sheet these items are on is named "Sheet1" and that the first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and
1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2: apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and
1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

I was able to duplicate your problem. It seems I forgot to reset the FoundIt
variable to False at the start of each loop. Because I did not do that, when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name
and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code
is
able to tell if the fruit already has a tab or not. thats grate for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the
macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab
and
1
apple tap
the second part would copy and past the rows that has the fruit in
side
the
specific tab.

i thanks in advance for the help