Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets has
about 70 lines and based on how much activity there was on a certain account
the lines can range from anywhere from no acctivity to all 70 lines. So what
I have done on the last coloumn on each sheet is put in a custom Auto Filter,
to show me only if the cell is greater than 0. My problem comes when I enter
a new set of data I have to go to each sheet and click on the filter and push
custom and ok, it takes a long time. I am sure there must be a quicker way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains subtotals
from all sheets and the second sheet conatins all the data for all the other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Hi Dejan,

Are you aware of 3-D references like for SUM of a specific cell range
from each sheet of range of sheets (left to right), you can make up a
name to the right side (and or left side) and insert your news sheets before
you high end sheet tab.

Since I goofed last time, so I will refer you directly to the HELP file
Using the Answer Wizard (search) in Excel Help
3D sheet references
then look at "Refer to the same cell or range on multiple sheets by using a 3-D reference"

Also you might make use of the following if automatic recalculation does
not take place.
Ctrl+Alt+F9 Recalculates all cells on all worksheets in all open workbooks.
Ctrl+Alt+Shift+F9 For Excel 2002 will rebuild all dependency trees.

---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"Dejan" wrote in message ...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets has
about 70 lines and based on how much activity there was on a certain account
the lines can range from anywhere from no acctivity to all 70 lines. So what
I have done on the last coloumn on each sheet is put in a custom Auto Filter,
to show me only if the cell is greater than 0. My problem comes when I enter
a new set of data I have to go to each sheet and click on the filter and push
custom and ok, it takes a long time. I am sure there must be a quicker way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains subtotals
from all sheets and the second sheet conatins all the data for all the other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Much better answer, I forgot to mention that I didn't really
understand the problem. So was only making some suggestions
that may or may not have any bearing. But your suggestion is the
obvious solution why make a lot more work and double the size
the of the workbook as well.

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message news:%
It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

"Dejan" wrote [clipped]
Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
Problem #2: With all of these 238 sheets the first sheet contains

Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

I have a macro that will extract the data from the database to separate
sheets (or separate workbooks) that will allow you to bypass the clicking
and filtering. When I get into work in the morning, I will post it.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two
Vlookup
names. Then what happens is there are 238 accounts so hence the 238
sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup
formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL
and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the
subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed
to
our customers. The whole process takes a long time. I know that you can
use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance
of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238
sheets
contain specific information to them. This information is put in from
a
master sheet via an Array formual, when I put in a new sheet all the
other
sheets gain their infromation from the master sheet. Each of the
sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines.
So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter
and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only
the
ones that have balance greater than 0 to a new sheet, is there any way
to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices) you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that you
could match the email to the exported file. That could be done in code as well: your whole process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Thank you very much, i will give this a try and let you know how I made out.

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices) you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that you
could match the email to the exported file. That could be done in code as well: your whole process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Hello Bernie,

That works great, now these are my next issues, would appreciate your help.

How would I get the macro to copy more than one row to the top of each
sheet. Then i also need copied the totals formulas at the bottom of the
database onto each sheet. Maybe if it asked me what row was the totals
located or if the totals row with formulas had then number 1 always in the
first a coloumn.

Thank you so much Bernie!

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices) you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that you
could match the email to the exported file. That could be done in code as well: your whole process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

Set up your totals using the SUBTOTAL function, using a formula like

=SUBTOTAL(9,B10:B1000)

Include all of your data in the range: when the data block is filtered, you will just sum the values
that are still visible.

Put the SUBTOTAL formulas into a single row separated from the bottom of your database by _at least
one completely blank line_.

Then we can simply change the line

.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")

to

myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues

That will pick up extra header rows, and the row of SUBTotals from the bottom - converted to values.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie,

That works great, now these are my next issues, would appreciate your help.

How would I get the macro to copy more than one row to the top of each
sheet. Then i also need copied the totals formulas at the bottom of the
database onto each sheet. Maybe if it asked me what row was the totals
located or if the totals row with formulas had then number 1 always in the
first a coloumn.

Thank you so much Bernie!

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this
after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices) you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that you
could match the email to the exported file. That could be done in code as well: your whole
process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Hello Again,

I need your help again, please. I got the worksheet to copy the subtotal
with your change of code. But I don't understand how it's suppose to copy
the first two rows.

The first row contains the date and the second conatins the headers. So how
can i get it to take both of the rows along with the appropriate account
information and subtotal.

Also one more question, is there a way for the code to first copy the two
rows as they are and only paste special the account information and the
subtotal line, so how would I get it to perform the task in two chuncks. Or
is there a way to have a template sheet and only to have the account
information pasted let's say on and after line 5 as paste sepcial, so there
would be this sheet let's say Sheet2 and it would already be formated and
have the header information. Then the macro would just paste special the
account information and subtotal ater line 5 and on, rename and continue with
next one.

Thanks again, I really appreciate you helping me.

Dejan

Thanks Bernie

"Bernie Deitrick" wrote:

Dejan,

Set up your totals using the SUBTOTAL function, using a formula like

=SUBTOTAL(9,B10:B1000)

Include all of your data in the range: when the data block is filtered, you will just sum the values
that are still visible.

Put the SUBTOTAL formulas into a single row separated from the bottom of your database by _at least
one completely blank line_.

Then we can simply change the line

.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")

to

myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues

That will pick up extra header rows, and the row of SUBTotals from the bottom - converted to values.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie,

That works great, now these are my next issues, would appreciate your help.

How would I get the macro to copy more than one row to the top of each
sheet. Then i also need copied the totals formulas at the bottom of the
database onto each sheet. Maybe if it asked me what row was the totals
located or if the totals row with formulas had then number 1 always in the
first a coloumn.

Thank you so much Bernie!

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this
after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices) you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that you
could match the email to the exported file. That could be done in code as well: your whole
process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

Put a blank row between the top row(s) and the row of headers. You should only have ONE row of
headers - if you have more, then insert the blank line above the last row of header values. Then
select a single cell within your data table, and run the macro again.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again,

I need your help again, please. I got the worksheet to copy the subtotal
with your change of code. But I don't understand how it's suppose to copy
the first two rows.

The first row contains the date and the second conatins the headers. So how
can i get it to take both of the rows along with the appropriate account
information and subtotal.

Also one more question, is there a way for the code to first copy the two
rows as they are and only paste special the account information and the
subtotal line, so how would I get it to perform the task in two chuncks. Or
is there a way to have a template sheet and only to have the account
information pasted let's say on and after line 5 as paste sepcial, so there
would be this sheet let's say Sheet2 and it would already be formated and
have the header information. Then the macro would just paste special the
account information and subtotal ater line 5 and on, rename and continue with
next one.

Thanks again, I really appreciate you helping me.

Dejan

Thanks Bernie

"Bernie Deitrick" wrote:

Dejan,

Set up your totals using the SUBTOTAL function, using a formula like

=SUBTOTAL(9,B10:B1000)

Include all of your data in the range: when the data block is filtered, you will just sum the
values
that are still visible.

Put the SUBTOTAL formulas into a single row separated from the bottom of your database by _at
least
one completely blank line_.

Then we can simply change the line

.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")

to

myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues

That will pick up extra header rows, and the row of SUBTotals from the bottom - converted to
values.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie,

That works great, now these are my next issues, would appreciate your help.

How would I get the macro to copy more than one row to the top of each
sheet. Then i also need copied the totals formulas at the bottom of the
database onto each sheet. Maybe if it asked me what row was the totals
located or if the totals row with formulas had then number 1 always in the
first a coloumn.

Thank you so much Bernie!

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this
after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices)
you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that
you
could match the email to the exported file. That could be done in code as well: your whole
process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Hello,

Now I understand how it works, thanks for help me out! I was putting a
blank row between the header rows and the data, that is why it wasn't
working, now it works fine, thanks so much!

Have a great day!

Dejan

"Bernie Deitrick" wrote:

Dejan,

Put a blank row between the top row(s) and the row of headers. You should only have ONE row of
headers - if you have more, then insert the blank line above the last row of header values. Then
select a single cell within your data table, and run the macro again.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again,

I need your help again, please. I got the worksheet to copy the subtotal
with your change of code. But I don't understand how it's suppose to copy
the first two rows.

The first row contains the date and the second conatins the headers. So how
can i get it to take both of the rows along with the appropriate account
information and subtotal.

Also one more question, is there a way for the code to first copy the two
rows as they are and only paste special the account information and the
subtotal line, so how would I get it to perform the task in two chuncks. Or
is there a way to have a template sheet and only to have the account
information pasted let's say on and after line 5 as paste sepcial, so there
would be this sheet let's say Sheet2 and it would already be formated and
have the header information. Then the macro would just paste special the
account information and subtotal ater line 5 and on, rename and continue with
next one.

Thanks again, I really appreciate you helping me.

Dejan

Thanks Bernie

"Bernie Deitrick" wrote:

Dejan,

Set up your totals using the SUBTOTAL function, using a formula like

=SUBTOTAL(9,B10:B1000)

Include all of your data in the range: when the data block is filtered, you will just sum the
values
that are still visible.

Put the SUBTOTAL formulas into a single row separated from the bottom of your database by _at
least
one completely blank line_.

Then we can simply change the line

.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")

to

myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues

That will pick up extra header rows, and the row of SUBTotals from the bottom - converted to
values.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie,

That works great, now these are my next issues, would appreciate your help.

How would I get the macro to copy more than one row to the top of each
sheet. Then i also need copied the totals formulas at the bottom of the
database onto each sheet. Maybe if it asked me what row was the totals
located or if the totals row with formulas had then number 1 always in the
first a coloumn.

Thank you so much Bernie!

Dejan

"Bernie Deitrick" wrote:

Dejan,

The macro below will create new files in the same folder as the workbook with the database.

If you wanted to email the spreadsheet after it is created, you could do something like this
after
the SaveAs line:

ActiveWorkbook.SendMail ", "This is the Subject line"

If you wanted to print each of the spreadsheet after they are created (to mail the invoices)
you
could do something like this after the SaveAs line:

ActiveSheet.PrintOut

Of course, you would need a table of email addresses that had the export key as well so that
you
could match the email to the exported file. That could be done in code as well: your whole
process
could be a one-button click to fire the macro.

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(Befo=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

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



"Dejan" wrote in message
...
Hello Bernie,

What I am doing is getting raw data from a shipping manfiest. Then what
happens is I format the manifest in a specific order and define two Vlookup
names. Then what happens is there are 238 accounts so hence the 238 sheets.
All 238 sheets pull their waybill's from that sheet then the Vlookup formula
gets the rest of the information for each waybill, quantity, cost etc.. on
each of the tabs. So what I have to do each time is print off the Master
sheet which has subtotals of all the sheets and then I painstakingly CTRL and
click through the workbook and highlight all the sheets that contain any
information. Then I copy these sheet along with the master and the subtotal
sheet to a new file. After i go through each sheet and click through the
Auto-Filter so that It only shows the rows with values in them, i have 70
rows that have a formula in them, and so I use the Auto-Filter to get only
the non-blank rows, i do that to each sheet, then It's ready to be emailed to
our customers. The whole process takes a long time. I know that you can use
the Filter on the master sheet but the whole thing is that the customer is
only suppose to see what they ordered, they only get their sheet. Hope
that's clear enough, I can send a sample if you would like.

Thanks for your help again...

Dejan

"Bernie Deitrick" wrote:

Dejan,

It sounds like you would be better off removing the 238 sheets and just
using the master sheet with a filter and as the data source for a pivot
table.

Describe what you are doing, and perhaps we can improve the performance of
the whole thing.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Problem #1: I have a giant workbook with 240 tabs. Each of the 238 sheets
contain specific information to them. This information is put in from a
master sheet via an Array formual, when I put in a new sheet all the other
sheets gain their infromation from the master sheet. Each of the sheets
has
about 70 lines and based on how much activity there was on a certain
account
the lines can range from anywhere from no acctivity to all 70 lines. So
what
I have done on the last coloumn on each sheet is put in a custom Auto
Filter,
to show me only if the cell is greater than 0. My problem comes when I
enter
a new set of data I have to go to each sheet and click on the filter and
push
custom and ok, it takes a long time. I am sure there must be a quicker
way
to ask all sheets to recalculate the Auto Filter. Please help

Problem #2: With all of these 238 sheets the first sheet contains
subtotals
from all sheets and the second sheet conatins all the data for all the
other
238 sheets. So what I have to do is go one by one sheet and copy only the
ones that have balance greater than 0 to a new sheet, is there any way to
have the sheets with a blanace of greater than 0 copied automatically.

Thanks in advance, any suggestions are appreciated.

Thanks.

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Hello Again Bernie,

Thanks alot for your help again, I figured that out after some trial and
error.

Now I have a nother problem, after it copies about 15 sheet or so I get this
error:

Excel cannot complete this taks with available resources. Choose less data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.

What am I doing wrong now?

Thanks for you input, once again.

btw: I have a 512 MB RAM, 2.0 GHZ Processor, Only Excel Open, I closed down
all other prongrams.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Dejan,

Sounds like a memory-leak problem. I haven't sued very large data sets with this macro: try adding

Application.CutCopyMode = False

just after the line:

..AutoFilter

Also, try this. Put this at the top of your module (just below the option explicit statement)

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

And put this somewhere in your module:

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub

Then put the line

ClearClipboard

within your loop (after the .AutoFilter line) as well.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again Bernie,

Thanks alot for your help again, I figured that out after some trial and
error.

Now I have a nother problem, after it copies about 15 sheet or so I get this
error:

Excel cannot complete this taks with available resources. Choose less data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.

What am I doing wrong now?

Thanks for you input, once again.

btw: I have a 512 MB RAM, 2.0 GHZ Processor, Only Excel Open, I closed down
all other prongrams.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Hello Bernie,

I put the new code in and this is the error I get now, I think I put it in
the right place tried to put in a few places but it doesn't want to work.

Also the ClearClipboard is not defined anywhere.

Thanks Bernie

Compile error:

Only comments may appear after End Sub, End Function, or end Property


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
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Resume
SheetExists:
Next myCell


End Sub

"Bernie Deitrick" wrote:

Dejan,

Sounds like a memory-leak problem. I haven't sued very large data sets with this macro: try adding

Application.CutCopyMode = False

just after the line:

..AutoFilter

Also, try this. Put this at the top of your module (just below the option explicit statement)

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

And put this somewhere in your module:

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub

Then put the line

ClearClipboard

within your loop (after the .AutoFilter line) as well.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again Bernie,

Thanks alot for your help again, I figured that out after some trial and
error.

Now I have a nother problem, after it copies about 15 sheet or so I get this
error:

Excel cannot complete this taks with available resources. Choose less data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.

What am I doing wrong now?

Thanks for you input, once again.

btw: I have a 512 MB RAM, 2.0 GHZ Processor, Only Excel Open, I closed down
all other prongrams.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Dejan,

Copy everything below into an otherwise blank codemodule.

HTH,
Bernie
MS Excel MVP

Option Explicit

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Resume
SheetExists:
Next myCell

End Sub

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub





"Dejan" wrote in message
...
Hello Bernie,

I put the new code in and this is the error I get now, I think I put it in
the right place tried to put in a few places but it doesn't want to work.

Also the ClearClipboard is not defined anywhere.

Thanks Bernie

Compile error:

Only comments may appear after End Sub, End Function, or end Property


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
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Resume
SheetExists:
Next myCell


End Sub

"Bernie Deitrick" wrote:

Dejan,

Sounds like a memory-leak problem. I haven't sued very large data sets with this macro: try
adding

Application.CutCopyMode = False

just after the line:

..AutoFilter

Also, try this. Put this at the top of your module (just below the option explicit statement)

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

And put this somewhere in your module:

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub

Then put the line

ClearClipboard

within your loop (after the .AutoFilter line) as well.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again Bernie,

Thanks alot for your help again, I figured that out after some trial and
error.

Now I have a nother problem, after it copies about 15 sheet or so I get this
error:

Excel cannot complete this taks with available resources. Choose less data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.

What am I doing wrong now?

Thanks for you input, once again.

btw: I have a 512 MB RAM, 2.0 GHZ Processor, Only Excel Open, I closed down
all other prongrams.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that
number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69
10321 5179033 8/25/2005 5 69
10321 5179887 8/25/2005 5 69
10322 3528294 8/19/2005 3 69
10322 4347692 7/27/2005 4 69
10322 4349443 8/8/2005 4 69
10322 4352698 8/24/2005 4 69
10322 5169595 7/26/2005 5 57
10322 5173816 7/26/2005 5 57
10322 5173834 7/26/2005 5 59
10322 5173966 7/26/2005 5 59
10322 5175808 8/5/2005 5 69
10322 5175888 8/17/2005 5 69
10322 5176031 8/8/2005 5 69
10322 5178039 8/17/2005 5 69
10322 5178905 8/23/2005 5 69
10322 5179328 8/23/2005 5 69

So once it finishes doing 10321, it brings up the error, any idea what's
wrong, thanks for all your help.

Dejan.
"Bernie Deitrick" wrote:

Dejan,

working, now it works fine,
Great!

thanks so much!
You're quite welcome.

Have a great day!
You, too.

Bernie
MS Excel MVP

Hello,

Sorry to bother again, did as you told, it did run a little longer but
still the same problem....

So i guess I'm back to square one then.

I really appreciate you tyring.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Copy everything below into an otherwise blank codemodule.

HTH,
Bernie
MS Excel MVP

Option Explicit

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Resume
SheetExists:
Next myCell

End Sub

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub





"Dejan" wrote in message
...
Hello Bernie,

I put the new code in and this is the error I get now, I think I put it in
the right place tried to put in a few places but it doesn't want to work.

Also the ClearClipboard is not defined anywhere.

Thanks Bernie

Compile error:

Only comments may appear after End Sub, End Function, or end Property


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
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Resume
SheetExists:
Next myCell


End Sub

"Bernie Deitrick" wrote:

Dejan,

Sounds like a memory-leak problem. I haven't sued very large data sets with this macro: try
adding

Application.CutCopyMode = False

just after the line:

..AutoFilter

Also, try this. Put this at the top of your module (just below the option explicit statement)

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

And put this somewhere in your module:

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub

Then put the line

ClearClipboard

within your loop (after the .AutoFilter line) as well.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Again Bernie,

Thanks alot for your help again, I figured that out after some trial and
error.

Now I have a nother problem, after it copies about 15 sheet or so I get this
error:

Excel cannot complete this taks with available resources. Choose less data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.

What am I doing wrong now?

Thanks for you input, once again.

btw: I have a 512 MB RAM, 2.0 GHZ Processor, Only Excel Open, I closed down
all other prongrams.

Dejan

"Bernie Deitrick" wrote:

Dejan,

Your key values are numbers, so change

myName = Worksheets(myCell.Value).Name

to

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

Worksheets can take either a number or a string - if it uses a number, it looks for that
number
sheet (the 10321st sheet) rather than one with that sheet name.

Sorry about that - I wrote the base code to work with alpha-numeric keys.

HTH,
Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello Bernie!

Sorry just one more problem, I was running the Macro on a actual sheet and I
got a this error:

Run-time error '1004':

Cannot rename a sheet to the same name as another sheet, a
referenced object library or workbook refreenced by Visual Basic.

It creates the first sheet fine, when it gets to the second customer that is
when it screws up this is the macro:

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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


End Sub

Here are some of the values from the first few coloumns:

A B C D E
ACCOUNT INVOICE INV DATE STR FBY
10321 5173728 8/9/2005 5 59
10321 5175563 8/4/2005 5 51
10321 5175736 8/11/2005 5 69
10321 5175804 8/5/2005 5 59
10321 5176748 8/11/2005 5 59
10321 5176751 8/11/2005 5 59
10321 5178686 8/19/2005 5 69

Dejan,

What happens if you stop the macro and then restart it? Try this, which will only do a set number of
sheets (20) each time it is run.

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
Dim Counter As Integer

Counter = 0
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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Counter = Counter +1
If Counter = 20 Then Exit Sub
Resume
SheetExists:
Next myCell

End Sub



"Dejan" wrote in message
...
Hello,

Sorry to bother again, did as you told, it did run a little longer but
still the same problem....

So i guess I'm back to square one then.

I really appreciate you tyring.

Dejan

Hello,

Yes that did work, not bad, still going to save alot of time.

Thanks and if you ever come up with something else, let me know.

Thanks.

Have a good weekend.

Dejan

"Bernie Deitrick" wrote:

Dejan,

What happens if you stop the macro and then restart it? Try this, which will only do a set number of
sheets (20) each time it is run.

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
Dim Counter As Integer

Counter = 0
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(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
Application.CutCopyMode = False
ClearClipboard
End With
Counter = Counter +1
If Counter = 20 Then Exit Sub
Resume
SheetExists:
Next myCell

End Sub



"Dejan" wrote in message
...
Hello,

Sorry to bother again, did as you told, it did run a little longer but
still the same problem....

So i guess I'm back to square one then.

I really appreciate you tyring.

Dejan

Dejan,

Great! And we've shattered my record for the greatest number of posts in a single thread! ;-)

Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Yes that did work, not bad, still going to save alot of time.

Thanks and if you ever come up with something else, let me know.

Thanks.

Have a good weekend.

Dejan

Hello Bernie,

Glad I could help you sir! Here is another one to add, I think I'm going to
do some research on google and see if I can find any other code to clear the
clipboard aside from the one you gave me.

I will post if I find anything better.

Thanks Again!

Dejan

"Bernie Deitrick" wrote:

Dejan,

Great! And we've shattered my record for the greatest number of posts in a single thread! ;-)

Bernie
MS Excel MVP


"Dejan" wrote in message
...
Hello,

Yes that did work, not bad, still going to save alot of time.

Thanks and if you ever come up with something else, let me know.

Thanks.

Have a good weekend.

Dejan

Hello Bernie,

Once again, I need your help sir! I found a really good macro, maybe you
can use this guy for the future as well. It does an awesome job, I just have
one problem. I need it to be able to copy a subtotal line at the bottom of
the data table from sheet one to each worksheet, I tried putting something
in, but it's not working out, you can have look, it's commented, this is the
macro I ended up using from you. Also I added a print formating Sub, not
sure If this is wrong or an easier way of doing this.

Thanks so much for your help.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long



Set ws1 = Sheets("Sheet1") '<<< Change

'Set ws1 = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

'Set ws1 = myArea.Resize(myArea.Rows.Count - 1, 1)
'Tip : Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this
if needed)
'You see that the last two columns of the worksheet are used to make
a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the
columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
Printing
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.CLEAR
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").CLEAR
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Sub Printing()
'
' Printing Macro
' Macro recorded 10/3/2005 by Dejan Lukic
'

'
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F"
.CenterFooter = "&A"
.RightFooter = "&P OF &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub