Create new worksheet from exisitng data

[JayL]

All -
I receive a monthly text file I import to Excel.
Column A represents a specific location by code - usually 3 digits with
numerous entries (rows) for each location code. I usually sort by Col A and
cut and paste all the same Col A rows into a new worksheet, thus creating a
new worksheet for each location code. Each worksheet would ideally be named
the location code.

There is potentially 20 or 30 worksheets - which is time consuming to create
manually.
Is there a way to automate this?

TIA
-Jay

[Bernie Deitrick]

Jay,

Yes.

Copy the macro below and put it into a codemodule of either your
personal.xls or of the workbook with the database.

Select a single cell in your database and run the macro. Since the key ID
values are in column A, and column A must be the first column of the
database,
enter a 1 when asked "What column # within database to use as key?"

The files will be saved to whatever folder is currently the default folder,
though that is easy to modify.

HTH,
Bernie
MS Excel MVP

Sub ExportDatabaseToSeparateFiles()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).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(before:=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht

End Sub


"JayL" <[email protected]> wrote in message
news:[email protected]...
> All -
> I receive a monthly text file I import to Excel.
> Column A represents a specific location by code - usually 3 digits with
> numerous entries (rows) for each location code. I usually sort by Col A
> and cut and paste all the same Col A rows into a new worksheet, thus
> creating a new worksheet for each location code. Each worksheet would
> ideally be named the location code.
>
> There is potentially 20 or 30 worksheets - which is time consuming to
> create manually.
> Is there a way to automate this?
>
> TIA
> -Jay
>
>

[JayL]

Bernie - Thanks! Works great on the first location code but as soon as it
hits the second location code I get and error "1004" cannot rename sheet to
same name as another. I think it is seeing row 3 as another sheet. ???
here is a snipet of col A and B
Ideally I would have one sheet of all the '101's and one sheet of all the
'111's ...etc
101 8081010766
101 8081010766
101 8081010766
101 8081010766
101 8081010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766

"Bernie Deitrick" <deitbe @ consumer dot org> wrote in message
news:[email protected]...
> Jay,
>
> Yes.
>
> Copy the macro below and put it into a codemodule of either your
> personal.xls or of the workbook with the database.
>
> Select a single cell in your database and run the macro. Since the key ID
> values are in column A, and column A must be the first column of the
> database,
> enter a 1 when asked "What column # within database to use as key?"
>
> The files will be saved to whatever folder is currently the default
> folder,
> though that is easy to modify.
>
> HTH,
> Bernie
> MS Excel MVP
>
> Sub ExportDatabaseToSeparateFiles()
> 'Export is based on the value in the desired column
> Dim myCell As Range
> Dim mySht As Worksheet
> Dim myName As String
> Dim myArea As Range
> Dim myShtName As String
> Dim KeyCol As Integer
>
> myShtName = ActiveSheet.Name
> KeyCol = InputBox("What column # within database to use as key?")
>
> Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).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(before:=Worksheets(1))
> mySht.Name = myCell.Value
> With myCell.CurrentRegion
> .AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
> .SpecialCells(xlCellTypeVisible).Copy _
> mySht.Range("A1")
> mySht.Cells.EntireColumn.AutoFit
> .AutoFilter
> End With
> Resume
> SheetExists:
> Next myCell
>
> 'Optional section to export the sheets to separate files
> 'For Each mySht In ActiveWorkbook.Worksheets
> 'If mySht.Name = myShtName Then
> 'Exit Sub
> 'Else
> 'mySht.Move
> 'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
> 'ActiveWorkbook.Close
> 'End If
> 'Next mySht
>
> End Sub
>
>
> "JayL" <[email protected]> wrote in message
> news:[email protected]...
>> All -
>> I receive a monthly text file I import to Excel.
>> Column A represents a specific location by code - usually 3 digits with
>> numerous entries (rows) for each location code. I usually sort by Col A
>> and cut and paste all the same Col A rows into a new worksheet, thus
>> creating a new worksheet for each location code. Each worksheet would
>> ideally be named the location code.
>>
>> There is potentially 20 or 30 worksheets - which is time consuming to
>> create manually.
>> Is there a way to automate this?
>>
>> TIA
>> -Jay
>>
>>
>
>

[Bernie Deitrick]

Jay,

The code was written for and tested on data that had strings for keys. Using
numbers requires that you change the line

myName = Worksheets(myCell.Value).Name

to

myName = Worksheets(CStr(myCell.Value)).Name

HTH,
Bernie
MS Excel MVP


"JayL" <[email protected]> wrote in message
news:[email protected]...
> Bernie - Thanks! Works great on the first location code but as soon as it
> hits the second location code I get and error "1004" cannot rename sheet
to
> same name as another. I think it is seeing row 3 as another sheet. ???
> here is a snipet of col A and B
> Ideally I would have one sheet of all the '101's and one sheet of all the
> '111's ...etc
> 101 8081010766
> 101 8081010766
> 101 8081010766
> 101 8081010766
> 101 8081010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
> 111 1111010766
>
> "Bernie Deitrick" <deitbe @ consumer dot org> wrote in message
> news:[email protected]...
> > Jay,
> >
> > Yes.
> >
> > Copy the macro below and put it into a codemodule of either your
> > personal.xls or of the workbook with the database.
> >
> > Select a single cell in your database and run the macro. Since the key
ID
> > values are in column A, and column A must be the first column of the
> > database,
> > enter a 1 when asked "What column # within database to use as key?"
> >
> > The files will be saved to whatever folder is currently the default
> > folder,
> > though that is easy to modify.
> >
> > HTH,
> > Bernie
> > MS Excel MVP
> >
> > Sub ExportDatabaseToSeparateFiles()
> > 'Export is based on the value in the desired column
> > Dim myCell As Range
> > Dim mySht As Worksheet
> > Dim myName As String
> > Dim myArea As Range
> > Dim myShtName As String
> > Dim KeyCol As Integer
> >
> > myShtName = ActiveSheet.Name
> > KeyCol = InputBox("What column # within database to use as key?")
> >
> > Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).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(before:=Worksheets(1))
> > mySht.Name = myCell.Value
> > With myCell.CurrentRegion
> > .AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
> > .SpecialCells(xlCellTypeVisible).Copy _
> > mySht.Range("A1")
> > mySht.Cells.EntireColumn.AutoFit
> > .AutoFilter
> > End With
> > Resume
> > SheetExists:
> > Next myCell
> >
> > 'Optional section to export the sheets to separate files
> > 'For Each mySht In ActiveWorkbook.Worksheets
> > 'If mySht.Name = myShtName Then
> > 'Exit Sub
> > 'Else
> > 'mySht.Move
> > 'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
> > 'ActiveWorkbook.Close
> > 'End If
> > 'Next mySht
> >
> > End Sub
> >
> >
> > "JayL" <[email protected]> wrote in message
> > news:[email protected]...
> >> All -
> >> I receive a monthly text file I import to Excel.
> >> Column A represents a specific location by code - usually 3 digits with
> >> numerous entries (rows) for each location code. I usually sort by Col A
> >> and cut and paste all the same Col A rows into a new worksheet, thus
> >> creating a new worksheet for each location code. Each worksheet would
> >> ideally be named the location code.
> >>
> >> There is potentially 20 or 30 worksheets - which is time consuming to
> >> create manually.
> >> Is there a way to automate this?
> >>
> >> TIA
> >> -Jay
> >>
> >>
> >
> >
>
>

[JayL]

Bernie -
Thanks! This is excellent!
-Jay


"Bernie Deitrick" <deitbe @ consumer dot org> wrote in message
news:[email protected]...
> Jay,
>
> The code was written for and tested on data that had strings for keys.
> Using
> numbers requires that you change the line
>
> myName = Worksheets(myCell.Value).Name
>
> to
>
> myName = Worksheets(CStr(myCell.Value)).Name
>
> HTH,
> Bernie
> MS Excel MVP
>
>
> "JayL" <[email protected]> wrote in message
> news:[email protected]...
>> Bernie - Thanks! Works great on the first location code but as soon as
>> it
>> hits the second location code I get and error "1004" cannot rename sheet
> to
>> same name as another. I think it is seeing row 3 as another sheet. ???
>> here is a snipet of col A and B
>> Ideally I would have one sheet of all the '101's and one sheet of all the
>> '111's ...etc
>> 101 8081010766
>> 101 8081010766
>> 101 8081010766
>> 101 8081010766
>> 101 8081010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>> 111 1111010766
>>
>> "Bernie Deitrick" <deitbe @ consumer dot org> wrote in message
>> news:[email protected]...
>> > Jay,
>> >
>> > Yes.
>> >
>> > Copy the macro below and put it into a codemodule of either your
>> > personal.xls or of the workbook with the database.
>> >
>> > Select a single cell in your database and run the macro. Since the key
> ID
>> > values are in column A, and column A must be the first column of the
>> > database,
>> > enter a 1 when asked "What column # within database to use as key?"
>> >
>> > The files will be saved to whatever folder is currently the default
>> > folder,
>> > though that is easy to modify.
>> >
>> > HTH,
>> > Bernie
>> > MS Excel MVP
>> >
>> > Sub ExportDatabaseToSeparateFiles()
>> > 'Export is based on the value in the desired column
>> > Dim myCell As Range
>> > Dim mySht As Worksheet
>> > Dim myName As String
>> > Dim myArea As Range
>> > Dim myShtName As String
>> > Dim KeyCol As Integer
>> >
>> > myShtName = ActiveSheet.Name
>> > KeyCol = InputBox("What column # within database to use as key?")
>> >
>> > Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).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(before:=Worksheets(1))
>> > mySht.Name = myCell.Value
>> > With myCell.CurrentRegion
>> > .AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
>> > .SpecialCells(xlCellTypeVisible).Copy _
>> > mySht.Range("A1")
>> > mySht.Cells.EntireColumn.AutoFit
>> > .AutoFilter
>> > End With
>> > Resume
>> > SheetExists:
>> > Next myCell
>> >
>> > 'Optional section to export the sheets to separate files
>> > 'For Each mySht In ActiveWorkbook.Worksheets
>> > 'If mySht.Name = myShtName Then
>> > 'Exit Sub
>> > 'Else
>> > 'mySht.Move
>> > 'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
>> > 'ActiveWorkbook.Close
>> > 'End If
>> > 'Next mySht
>> >
>> > End Sub
>> >
>> >
>> > "JayL" <[email protected]> wrote in message
>> > news:[email protected]...
>> >> All -
>> >> I receive a monthly text file I import to Excel.
>> >> Column A represents a specific location by code - usually 3 digits
>> >> with
>> >> numerous entries (rows) for each location code. I usually sort by Col
>> >> A
>> >> and cut and paste all the same Col A rows into a new worksheet, thus
>> >> creating a new worksheet for each location code. Each worksheet would
>> >> ideally be named the location code.
>> >>
>> >> There is potentially 20 or 30 worksheets - which is time consuming to
>> >> create manually.
>> >> Is there a way to automate this?
>> >>
>> >> TIA
>> >> -Jay
>> >>
>> >>
>> >
>> >
>>
>>
>
>

[Bernie Deitrick]

Jay,

You're welcome. Glad you liked it.

Bernie
MS Excel MVP

> Bernie -
> Thanks! This is excellent!
> -Jay

[LoboNetwork]

Hello bernie,

I used this code here however the saving of the sheets to separate files
didnt work. Any ideas or anything I need to enable?

"Bernie Deitrick" wrote:

> Jay,
>
> You're welcome. Glad you liked it.
>
> Bernie
> MS Excel MVP
>
> > Bernie -
> > Thanks! This is excellent!
> > -Jay
>
>
>