Ok I have to be difficult
 

Anyone have any suggestions on how I should do this without resorting to
Access?

I have a sheet with Column R representing the State a particular file is in.
I'll get a file like this every few weeks. I'd like to automate how I need
it broken down. I'd like to have a new sheet created for each unique state
(not all 50 states) in Column R. Then have all the rows that in Column R
copied to each sheet that matches the value in that row. For example I have
20 unique states, create 20 sheets using those values, copy all rows that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might handle
this idea better. Bosses really dont want to use it though. Let me know.

Thanks

Ok I have to be difficult
 

Dominique,

Try the sub below: assumes that data in column R starts in R2, and the first row is labels.

HTH,
Bernie
MS Excel MVP


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

Set myArea = Range("R2").CurrentRegion

Set myArea = Intersect(Range("R:R"), myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1))
FieldNum = 19 - ActiveCell.CurrentRegion.Columns(1).Column
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:=FieldNum, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub




"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting to
Access?

I have a sheet with Column R representing the State a particular file is in.
I'll get a file like this every few weeks. I'd like to automate how I need
it broken down. I'd like to have a new sheet created for each unique state
(not all 50 states) in Column R. Then have all the rows that in Column R
copied to each sheet that matches the value in that row. For example I have
20 unique states, create 20 sheets using those values, copy all rows that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might handle
this idea better. Bosses really dont want to use it though. Let me know.

Thanks

Ok I have to be difficult
 

Ooops, should have changed one other thing:

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

Set myArea = Range("R2").CurrentRegion

Set myArea = Intersect(Range("R:R"), myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1))
FieldNum = 19 - Range("R2").CurrentRegion.Columns(1).Column
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:=FieldNum, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


--
HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Dominique,

Try the sub below: assumes that data in column R starts in R2, and the first row is labels.

HTH,
Bernie
MS Excel MVP


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

Set myArea = Range("R2").CurrentRegion

Set myArea = Intersect(Range("R:R"), myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1))
FieldNum = 19 - ActiveCell.CurrentRegion.Columns(1).Column
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:=FieldNum, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub




"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting to
Access?

I have a sheet with Column R representing the State a particular file is in.
I'll get a file like this every few weeks. I'd like to automate how I need
it broken down. I'd like to have a new sheet created for each unique state
(not all 50 states) in Column R. Then have all the rows that in Column R
copied to each sheet that matches the value in that row. For example I have
20 unique states, create 20 sheets using those values, copy all rows that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might handle
this idea better. Bosses really dont want to use it though. Let me know.

Thanks

Ok I have to be difficult
 

Sub States()
Dim sh As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh = ActiveSheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting to
Access?

I have a sheet with Column R representing the State a particular file is
in.
I'll get a file like this every few weeks. I'd like to automate how I
need
it broken down. I'd like to have a new sheet created for each unique
state
(not all 50 states) in Column R. Then have all the rows that in Column R
copied to each sheet that matches the value in that row. For example I
have
20 unique states, create 20 sheets using those values, copy all rows that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might handle
this idea better. Bosses really dont want to use it though. Let me know.

Thanks

Ok I have to be difficult
 

Thanks a ton.

Really appreciate that. did exactly what i wanted.
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Ooops, should have changed one other thing:

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

Set myArea = Range("R2").CurrentRegion

Set myArea = Intersect(Range("R:R"), myArea.Offset(1,
0).Resize(myArea.Rows.Count - 1))
FieldNum = 19 - Range("R2").CurrentRegion.Columns(1).Column
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:=FieldNum, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


--
HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Dominique,

Try the sub below: assumes that data in column R starts in R2, and the
first row is labels.

HTH,
Bernie
MS Excel MVP


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

Set myArea = Range("R2").CurrentRegion

Set myArea = Intersect(Range("R:R"), myArea.Offset(1,
0).Resize(myArea.Rows.Count - 1))
FieldNum = 19 - ActiveCell.CurrentRegion.Columns(1).Column
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:=FieldNum, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub




"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting
to
Access?

I have a sheet with Column R representing the State a particular file
is in.
I'll get a file like this every few weeks. I'd like to automate how I
need
it broken down. I'd like to have a new sheet created for each unique
state
(not all 50 states) in Column R. Then have all the rows that in Column
R
copied to each sheet that matches the value in that row. For example I
have
20 unique states, create 20 sheets using those values, copy all rows
that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might
handle
this idea better. Bosses really dont want to use it though. Let me
know.

Thanks

Ok I have to be difficult
 

Bob,

BRILLIANT !!!

My only concern is this (and I have written mods to your code in order to
accomdate it) -- your method destroys the original data, which is not an
assumption the user allowed necessarily. I altered the code (below) to not
delete the old data ... it may be awkward, not sure. I coded around some
problems and had to make i a non-integer (yuck). There is a problem with
"our" method using Union, however, and it is a problem both our solutions
sha If the data comes in with alternating states and there are a lot of
rows, like this
Utah
Ohio
Utah
California
Utah
Ohio
Utah
etc... then the Unioned ranges become objects with a large number of
non-contiguous rows, and while there is no limit on them, they are slower
than fudge rolling down an iceberg.

Let's therefore recommend to the OP that he/she Sort the data first!

Here is code that doesn't delete the old data. It is based on Bob's method,
so I cannot take any credit. Maybe he can clean up my mess also.

Sub States()
Dim sh As Worksheet
Dim MySheet As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Double, lCopied As Long
Dim rTemp As Range
Dim mcol As New Collection

Application.ScreenUpdating = False
Set sh = ActiveSheet
stemp = Range("A1")
mcol.Add stemp, stemp
i = 2
Do While Not (rTemp Is Nothing) Or i = 2
If Not (rTemp Is Nothing) Then
i = rTemp.Row + 1 'There was a new starting place
stemp = rTemp.Value
Set rTemp = Nothing
End If
Set rng = Rows(i - 1)
Do While Cells(Int(i), "A") < "" And i <= 65536
If Cells(i, 1).Value = stemp Then
Set rng = Union(rng, Rows(i))
Else
If rTemp Is Nothing Then
On Error Resume Next
mcol.Add Cells(i, "A").Value, Cells(i, "A").Value
If Err.Number = 0 Then
Set rTemp = Cells(i, 1) 'Next Starting Place
End If
Err.Clear
On Error GoTo 0
End If
End If
i = i + 1
If i = 65537 Then i = 65536.1
Loop
Worksheets.Add.Name = stemp

rng.Copy Worksheets(stemp).Range("A1")
sh.Activate
Loop

End Sub


I wasn't sure the OP wanted a method that was destructive to their data so I
changed your method to use a collection to hold the "next place" to pick up
the hunt for new States. It is very repetitive
"Bob Phillips" wrote in message
...
Sub States()
Dim sh As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh = ActiveSheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting to
Access?

I have a sheet with Column R representing the State a particular file is
in.
I'll get a file like this every few weeks. I'd like to automate how I
need
it broken down. I'd like to have a new sheet created for each unique
state
(not all 50 states) in Column R. Then have all the rows that in Column R
copied to each sheet that matches the value in that row. For example I
have
20 unique states, create 20 sheets using those values, copy all rows that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might
handle
this idea better. Bosses really dont want to use it though. Let me know.

Thanks

Ok I have to be difficult
 

Here is a much easier solution if you want to preserve the data

Sub States()
Dim sh As Worksheet
Dim sh1 as Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh1 = ActiveSheet
sh1.Copy After:=worksheets(worksheets.count)
Set sh = Activesheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop
Application.DisplayAlerts = False
sh.Delete
Application.DisplaAlerts = True
sh1.Activate
End Sub

--
Regards,
Tom Ogilvy

"William Benson" wrote in message
...
Bob,

BRILLIANT !!!

My only concern is this (and I have written mods to your code in order to
accomdate it) -- your method destroys the original data, which is not an
assumption the user allowed necessarily. I altered the code (below) to
not
delete the old data ... it may be awkward, not sure. I coded around some
problems and had to make i a non-integer (yuck). There is a problem with
"our" method using Union, however, and it is a problem both our solutions
sha If the data comes in with alternating states and there are a lot
of
rows, like this
Utah
Ohio
Utah
California
Utah
Ohio
Utah
etc... then the Unioned ranges become objects with a large number of
non-contiguous rows, and while there is no limit on them, they are slower
than fudge rolling down an iceberg.

Let's therefore recommend to the OP that he/she Sort the data first!

Here is code that doesn't delete the old data. It is based on Bob's
method,
so I cannot take any credit. Maybe he can clean up my mess also.

Sub States()
Dim sh As Worksheet
Dim MySheet As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Double, lCopied As Long
Dim rTemp As Range
Dim mcol As New Collection

Application.ScreenUpdating = False
Set sh = ActiveSheet
stemp = Range("A1")
mcol.Add stemp, stemp
i = 2
Do While Not (rTemp Is Nothing) Or i = 2
If Not (rTemp Is Nothing) Then
i = rTemp.Row + 1 'There was a new starting place
stemp = rTemp.Value
Set rTemp = Nothing
End If
Set rng = Rows(i - 1)
Do While Cells(Int(i), "A") < "" And i <= 65536
If Cells(i, 1).Value = stemp Then
Set rng = Union(rng, Rows(i))
Else
If rTemp Is Nothing Then
On Error Resume Next
mcol.Add Cells(i, "A").Value, Cells(i, "A").Value
If Err.Number = 0 Then
Set rTemp = Cells(i, 1) 'Next Starting Place
End If
Err.Clear
On Error GoTo 0
End If
End If
i = i + 1
If i = 65537 Then i = 65536.1
Loop
Worksheets.Add.Name = stemp

rng.Copy Worksheets(stemp).Range("A1")
sh.Activate
Loop

End Sub


I wasn't sure the OP wanted a method that was destructive to their data so
I
changed your method to use a collection to hold the "next place" to pick
up
the hunt for new States. It is very repetitive
"Bob Phillips" wrote in message
...
Sub States()
Dim sh As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh = ActiveSheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting
to
Access?

I have a sheet with Column R representing the State a particular file
is
in.
I'll get a file like this every few weeks. I'd like to automate how I
need
it broken down. I'd like to have a new sheet created for each unique
state
(not all 50 states) in Column R. Then have all the rows that in Column
R
copied to each sheet that matches the value in that row. For example I
have
20 unique states, create 20 sheets using those values, copy all rows
that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might
handle
this idea better. Bosses really dont want to use it though. Let me
know.

Thanks

Ok I have to be difficult
 

Yep, Occam's Razor at work ... copy the data.

Tom you are a gentleman indeed for not rubbing my nose in that one!


"Tom Ogilvy" wrote in message
...
Here is a much easier solution if you want to preserve the data

Sub States()
Dim sh As Worksheet
Dim sh1 as Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh1 = ActiveSheet
sh1.Copy After:=worksheets(worksheets.count)
Set sh = Activesheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop
Application.DisplayAlerts = False
sh.Delete
Application.DisplaAlerts = True
sh1.Activate
End Sub

--
Regards,
Tom Ogilvy

"William Benson" wrote in message
...
Bob,

BRILLIANT !!!

My only concern is this (and I have written mods to your code in order to
accomdate it) -- your method destroys the original data, which is not an
assumption the user allowed necessarily. I altered the code (below) to
not
delete the old data ... it may be awkward, not sure. I coded around some
problems and had to make i a non-integer (yuck). There is a problem with
"our" method using Union, however, and it is a problem both our solutions
sha If the data comes in with alternating states and there are a lot
of
rows, like this
Utah
Ohio
Utah
California
Utah
Ohio
Utah
etc... then the Unioned ranges become objects with a large number of
non-contiguous rows, and while there is no limit on them, they are slower
than fudge rolling down an iceberg.

Let's therefore recommend to the OP that he/she Sort the data first!

Here is code that doesn't delete the old data. It is based on Bob's
method,
so I cannot take any credit. Maybe he can clean up my mess also.

Sub States()
Dim sh As Worksheet
Dim MySheet As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Double, lCopied As Long
Dim rTemp As Range
Dim mcol As New Collection

Application.ScreenUpdating = False
Set sh = ActiveSheet
stemp = Range("A1")
mcol.Add stemp, stemp
i = 2
Do While Not (rTemp Is Nothing) Or i = 2
If Not (rTemp Is Nothing) Then
i = rTemp.Row + 1 'There was a new starting place
stemp = rTemp.Value
Set rTemp = Nothing
End If
Set rng = Rows(i - 1)
Do While Cells(Int(i), "A") < "" And i <= 65536
If Cells(i, 1).Value = stemp Then
Set rng = Union(rng, Rows(i))
Else
If rTemp Is Nothing Then
On Error Resume Next
mcol.Add Cells(i, "A").Value, Cells(i, "A").Value
If Err.Number = 0 Then
Set rTemp = Cells(i, 1) 'Next Starting Place
End If
Err.Clear
On Error GoTo 0
End If
End If
i = i + 1
If i = 65537 Then i = 65536.1
Loop
Worksheets.Add.Name = stemp

rng.Copy Worksheets(stemp).Range("A1")
sh.Activate
Loop

End Sub


I wasn't sure the OP wanted a method that was destructive to their data
so
I
changed your method to use a collection to hold the "next place" to pick
up
the hunt for new States. It is very repetitive
"Bob Phillips" wrote in message
...
Sub States()
Dim sh As Worksheet
Dim stemp As String
Dim rng As Range
Dim i As Long

Set sh = ActiveSheet
Do While Range("A1").Value < ""
stemp = Range("A1")
Set rng = Rows(1)
i = 2
Do While Cells(i, "A") < ""
If Cells(i, "A").Value = stemp Then
Set rng = Union(rng, Rows(i))
End If
i = i + 1
Loop
Worksheets.add.Name = stemp
rng.Copy Worksheets(stemp).Range("A1")
rng.Delete
sh.Activate
Loop

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dominique Feteau" wrote in message
...
Anyone have any suggestions on how I should do this without resorting
to
Access?

I have a sheet with Column R representing the State a particular file
is
in.
I'll get a file like this every few weeks. I'd like to automate how I
need
it broken down. I'd like to have a new sheet created for each unique
state
(not all 50 states) in Column R. Then have all the rows that in
Column
R
copied to each sheet that matches the value in that row. For example
I
have
20 unique states, create 20 sheets using those values, copy all rows
that
match the names of the sheets.

I'm trying to figure it out, but I have a feeling that Access might
handle
this idea better. Bosses really dont want to use it though. Let me
know.

Thanks