I have about 10 workbooks all setup the same with the same formating,
formulas, etc. but all with different data. Lets say they are called
"workbook1.xls to workbook10.xls". All data is located on "sheet 1". There is
one column (lets say "D") that has a calculated date in it. I want to be able
to check the entire column "D" and find any values that are less than the
date I specified. If it finds a less than or equal to date, then it will take
all the values in that specific row and paste it into a summary workbook that
I have already setup. Lets call this workbook "summary.xls". The program will
then continue down column D and find any other less than or equal to dates
and take the information on the entire row and copy it into the "summary.xls"
workbook in the next available line. Once it has checked the first workbook,
the program will then check workbook2.xls and so on, copying all the values
of a row into the summary.xls if the date in column D is less than the one
specified.

On Thu, 17 Aug 2006 07:34:02 -0700, Brian
wrote:

I have about 10 workbooks all setup the same with the same formating,
formulas, etc. but all with different data. Lets say they are called
"workbook1.xls to workbook10.xls". All data is located on "sheet 1". There is
one column (lets say "D") that has a calculated date in it. I want to be able
to check the entire column "D" and find any values that are less than the
date I specified. If it finds a less than or equal to date, then it will take
all the values in that specific row and paste it into a summary workbook that
I have already setup. Lets call this workbook "summary.xls". The program will
then continue down column D and find any other less than or equal to dates
and take the information on the entire row and copy it into the "summary.xls"
workbook in the next available line. Once it has checked the first workbook,
the program will then check workbook2.xls and so on, copying all the values
of a row into the summary.xls if the date in column D is less than the one
specified.


One way would be to use the procedure below.
It requires you to have two Range names.

Put your selected test date in say A1 and name it "MyDate". e.g.
17/08/2006 (that's a UK style date in case it's confusing!)

Put the folder which contains your files in say B1 and name it "My
Folder". e.g. "C:\test"

It also assumes that there is a consistent naming convention to your
workbooks. i.e. workbook1.xls, workbook2.xls so that it does not open
any other files. Change this as appropriate. At the moment it looks
for the first 8 characters of the name, i.e. "workbook". This is case
sensitive.

If you only have your required files and the master Summary workbook
in the folder then the If.. Then test could be changed to If File.Name
M<"Summary"

Put the same field headings from your workbooks in the Summary
workbook starting in column A. Change the procedure if necessary from
A65536 to whichever column contains the extracted records.


Sub ExtractDateRecords()
Dim oFSO
Dim oMyFolder As Object
Dim Files As Object
Dim File As Object
Dim Mydate As String
Dim MyWb As Workbook
Dim Tempwb As Workbook

Set MyWb = ActiveWorkbook
Mydate = Range("mydate")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oMyFolder = oFSO.GetFolder(Range("Myfolder"))

For Each File In oMyFolder.Files
If Left(File.Name, 8) = "workbook" Then
Workbooks.Open Filename:=File.Path
Set Tempwb = ActiveWorkbook
Range("D1").AutoFilter Field:=4, Criteria1:="<=" & Mydate

Range("D1").CurrentRegion.Offset(1,0).SpecialCells (xlCellTypeVisible).Copy
MyWb.Activate

Range("a65536").End(xlUp).Offset(1,0).PasteSpecial (xlPasteAll)
Tempwb.Close
End If
Next File

Set oFSO = Nothing
Application.ScreenUpdating = True
End Sub


HTH
__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

I was able to get some of this to work, however if I run the macro and it
filters a sheet with no data in column D, then I get an error and it stops.
Any way to fix this?
Also when it copies to the blank sheet, it copies all the formulas, etc. I
would like to paste any data picked up on the filter into the blank sheet as
special and give me only the values and the formating that it has on the
original sheet.

"Richard Buttrey" wrote:

On Thu, 17 Aug 2006 07:34:02 -0700, Brian
wrote:

I have about 10 workbooks all setup the same with the same formating,
formulas, etc. but all with different data. Lets say they are called
"workbook1.xls to workbook10.xls". All data is located on "sheet 1". There is
one column (lets say "D") that has a calculated date in it. I want to be able
to check the entire column "D" and find any values that are less than the
date I specified. If it finds a less than or equal to date, then it will take
all the values in that specific row and paste it into a summary workbook that
I have already setup. Lets call this workbook "summary.xls". The program will
then continue down column D and find any other less than or equal to dates
and take the information on the entire row and copy it into the "summary.xls"
workbook in the next available line. Once it has checked the first workbook,
the program will then check workbook2.xls and so on, copying all the values
of a row into the summary.xls if the date in column D is less than the one
specified.


One way would be to use the procedure below.
It requires you to have two Range names.

Put your selected test date in say A1 and name it "MyDate". e.g.
17/08/2006 (that's a UK style date in case it's confusing!)

Put the folder which contains your files in say B1 and name it "My
Folder". e.g. "C:\test"

It also assumes that there is a consistent naming convention to your
workbooks. i.e. workbook1.xls, workbook2.xls so that it does not open
any other files. Change this as appropriate. At the moment it looks
for the first 8 characters of the name, i.e. "workbook". This is case
sensitive.

If you only have your required files and the master Summary workbook
in the folder then the If.. Then test could be changed to If File.Name
M<"Summary"

Put the same field headings from your workbooks in the Summary
workbook starting in column A. Change the procedure if necessary from
A65536 to whichever column contains the extracted records.


Sub ExtractDateRecords()
Dim oFSO
Dim oMyFolder As Object
Dim Files As Object
Dim File As Object
Dim Mydate As String
Dim MyWb As Workbook
Dim Tempwb As Workbook

Set MyWb = ActiveWorkbook
Mydate = Range("mydate")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oMyFolder = oFSO.GetFolder(Range("Myfolder"))

For Each File In oMyFolder.Files
If Left(File.Name, 8) = "workbook" Then
Workbooks.Open Filename:=File.Path
Set Tempwb = ActiveWorkbook
Range("D1").AutoFilter Field:=4, Criteria1:="<=" & Mydate

Range("D1").CurrentRegion.Offset(1,0).SpecialCells (xlCellTypeVisible).Copy
MyWb.Activate

Range("a65536").End(xlUp).Offset(1,0).PasteSpecial (xlPasteAll)
Tempwb.Close
End If
Next File

Set oFSO = Nothing
Application.ScreenUpdating = True
End Sub


HTH
__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

Hi,
Try this slight modification

HTH.

Sub ExtractDateRecords()
Dim oFSO
Dim myFolder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Dim Mydate As String
Dim MyWb As Workbook
Dim Tempwb As Workbook
Dim stTopCell As String
Application.DisplayAlerts = False
Set MyWb = ActiveWorkbook
Mydate = Range("mydate")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = oFSO.GetFolder(Range("Myfolder"))

For Each file In myFolder.Files
If Left(file.Name, 8) = "Workbook" Then
Workbooks.Open Filename:=file.Path
Set Tempwb = ActiveWorkbook
Range("D1").AutoFilter Field:=4, Criteria1:="<=" & Mydate
If Range("d1").Offset(1, 0) < "" Then

Range("D1").CurrentRegion.Offset(1,0).SpecialCells (xlCellTypeVisible).Copy
MyWb.Activate
stTopCell = Range("a65536").End(xlUp).Offset(1,0).Address
Range(stTopCell).PasteSpecial (xlPasteAll)
Range(stTopCell).PasteSpecial (xlPasteValues)
End If
Tempwb.Close
End If
Next file

Set oFSO = Nothing

End Sub




On Fri, 18 Aug 2006 07:45:44 -0700, Brian
wrote:

I was able to get some of this to work, however if I run the macro and it
filters a sheet with no data in column D, then I get an error and it stops.
Any way to fix this?
Also when it copies to the blank sheet, it copies all the formulas, etc. I
would like to paste any data picked up on the filter into the blank sheet as
special and give me only the values and the formating that it has on the
original sheet.

"Richard Buttrey" wrote:

On Thu, 17 Aug 2006 07:34:02 -0700, Brian
wrote:

I have about 10 workbooks all setup the same with the same formating,
formulas, etc. but all with different data. Lets say they are called
"workbook1.xls to workbook10.xls". All data is located on "sheet 1". There is
one column (lets say "D") that has a calculated date in it. I want to be able
to check the entire column "D" and find any values that are less than the
date I specified. If it finds a less than or equal to date, then it will take
all the values in that specific row and paste it into a summary workbook that
I have already setup. Lets call this workbook "summary.xls". The program will
then continue down column D and find any other less than or equal to dates
and take the information on the entire row and copy it into the "summary.xls"
workbook in the next available line. Once it has checked the first workbook,
the program will then check workbook2.xls and so on, copying all the values
of a row into the summary.xls if the date in column D is less than the one
specified.


One way would be to use the procedure below.
It requires you to have two Range names.

Put your selected test date in say A1 and name it "MyDate". e.g.
17/08/2006 (that's a UK style date in case it's confusing!)

Put the folder which contains your files in say B1 and name it "My
Folder". e.g. "C:\test"

It also assumes that there is a consistent naming convention to your
workbooks. i.e. workbook1.xls, workbook2.xls so that it does not open
any other files. Change this as appropriate. At the moment it looks
for the first 8 characters of the name, i.e. "workbook". This is case
sensitive.

If you only have your required files and the master Summary workbook
in the folder then the If.. Then test could be changed to If File.Name
M<"Summary"

Put the same field headings from your workbooks in the Summary
workbook starting in column A. Change the procedure if necessary from
A65536 to whichever column contains the extracted records.


Sub ExtractDateRecords()
Dim oFSO
Dim oMyFolder As Object
Dim Files As Object
Dim File As Object
Dim Mydate As String
Dim MyWb As Workbook
Dim Tempwb As Workbook

Set MyWb = ActiveWorkbook
Mydate = Range("mydate")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oMyFolder = oFSO.GetFolder(Range("Myfolder"))

For Each File In oMyFolder.Files
If Left(File.Name, 8) = "workbook" Then
Workbooks.Open Filename:=File.Path
Set Tempwb = ActiveWorkbook
Range("D1").AutoFilter Field:=4, Criteria1:="<=" & Mydate

Range("D1").CurrentRegion.Offset(1,0).SpecialCells (xlCellTypeVisible).Copy
MyWb.Activate

Range("a65536").End(xlUp).Offset(1,0).PasteSpecial (xlPasteAll)
Tempwb.Close
End If
Next File

Set oFSO = Nothing
Application.ScreenUpdating = True
End Sub


HTH
__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________


__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________