Help needed

[thunder_anger]

hi all
after searching for a job
finally i took a job in a huge accounting firm but during my first days i was assigned to sort the archives of this firm
i was shocked because i thought that it will be easy
the persons who were working before me made it easy for me
they created about 3300 XLS files but there is a huge problem

My boss told me that he wants a report about all clients from 10/10/1990 to 1/1/2011 who paid us less than 500$

3300 XLS files and the report is needed
is there a way to search for those clients in all files and return that information in a new sheet
all files are similar (same table )
dates are in column ("D")
Payed Value in Column ("S")
xls files names are from
A1001 to A4301

i know that you will help

 

[MrKowz]

Are all of the files in the same folder? And is the name of the worksheet to look in consistent with all of the files?

 

[thunder_anger]

Are all of the files in the same folder? And is the name of the worksheet to look in consistent with all of the files?

yes
all files are in the same folder
and all names are as i said
A1001 to A4301
3300 xls files

 

[MrKowz]

I understand the workbook names, but as far as the worksheet (tab name) they are in, is it always going to be "Sheet1"?

 

[thunder_anger]

Oh sorry
i am not a native English speaker

yeas the sheets are all the same name

every workbook contains 6 sheets

all what concern me is "ClientsRec" sheet

 

[MrKowz]

Try this out. Take note of the following, and consider doing a trial run of the macro to make sure it is going to capture the data you require:

• Store this code in a NEW workbook that is in the same folder as the files to check
• This code WILL take a long time to run. Consider allowing this to run in its entirity when you do not need to use the computer for a couple of hours.
• If you choose to run a trial, it will check the first ten files so you can manually check to ensure it is capturing all of the data you need.

Option Explicit
' MrKowz : April 11, 2011 : [URL]http://www.mrexcel.com/forum/showthread.php?t=542636[/URL]
' This macro will open files A1001 through A4301 and copy all records whose date is
'   between 10/10/1990 and 01/01/2011, and who was paid less than $500.
' Consistencies:
'   *   Data for each worksheet lies in the sheet "ClientsRec"
'   *   The date to check lies in Column D
'   *   The pay to check lies in Column S
' Notes:
'   *   Store this code in a {{NEW}} workbook that is in the same folder as the files to check
'   *   This code WILL take a long time to run.  Consider allowing this to run in its
'       entirity when you do not need to use the computer for a couple of hours.
'   *   If you choose to run a trial, it will check the first ten files so you can manually
'       check to ensure it is capturing all of the data you need.
Public Sub ChecksReport()
Dim wbCount     As Long, _
    parentdirec As String, _
    fName       As String, _
    dWB         As Workbook, _
    dWS         As Worksheet, _
    sWB         As Workbook, _
    sWS         As Worksheet, _
    rowx        As Long, _
    sLR         As Long, _
    i           As Long, _
    trial       As VbMsgBoxResult, _
    MaxWB       As Long
    
Set dWB = ActiveWorkbook
Set dWS = dWB.ActiveSheet
rowx = 2
parentdirec = ActiveWorkbook.Path
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With
trial = MsgBox("Would you like to run a test of this macro?", vbYesNo, "Trial Run")
If trial = vbYes Then
    MaxWB = 1010
Else
    MaxWB = 4301
End If
For wbCount = 1001 To MaxWB
    fName = "A" & wbCount & ".xls"
    Application.StatusBar = "Currently opening " & fName
    Workbooks.Open parentdirec & "\" & fName
    Set sWB = Workbooks(fName)
    Set sWS = sWB.Sheets("ClientsRec")
    sLR = sWS.Range("D" & rows.Count).End(xlUp).Row
    For i = 1 To sLR
        Application.StatusBar = "Currently checking row " & i & "/" & LR & " in " & fName
        If sWS.Range("D" & i).Value >= DateSerial(1990, 10, 10) And sWS.Range("D" & i).Value <= DateSerial(2011, 1, 1) And sWS.Range("S" & i).Value <= 500 Then
            If rowx >= 65530 Then
                dWB.Sheets.Add after:=Sheets(Sheets.Count)
                Set dWS = dWB.ActiveSheet
                rowx = 2
            End If
            sWS.rows(i).Copy Destination:=dWS.Range("A" & rowx)
            rowx = rowx + 1
        End If
    Next i
    Application.StatusBar = "Currently closing " & fName
    sWB.Close
Next wbCount
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .StatusBar = False
End With
End Sub

 

[thunder_anger]

God!!!
Thanks for this reply
you have saved me
but is it a must to put my new workbook in the same directory as the 3300 files??

and i must understand what happened here??
every line please

 

[thunder_anger]

Error


Variable not found

IN RED

Application.StatusBar = "Currently checking row " & i & "/" & LR & " in " & fName

 

[MrKowz]

Missed that one - try:

Option Explicit
' MrKowz : April 11, 2011 : [URL]http://www.mrexcel.com/forum/showthread.php?t=542636[/URL]
' This macro will open files A1001 through A4301 and copy all records whose date is
'   between 10/10/1990 and 01/01/2011, and who was paid less than $500.
' Consistencies:
'   *   Data for each worksheet lies in the sheet "ClientsRec"
'   *   The date to check lies in Column D
'   *   The pay to check lies in Column S
' Notes:
'   *   Store this code in a {{NEW}} workbook that is in the same folder as the files to check
'   *   This code WILL take a long time to run.  Consider allowing this to run in its
'       entirity when you do not need to use the computer for a couple of hours.
'   *   If you choose to run a trial, it will check the first ten files so you can manually
'       check to ensure it is capturing all of the data you need.
Public Sub ChecksReport()
Dim wbCount     As Long, _
    parentdirec As String, _
    fName       As String, _
    dWB         As Workbook, _
    dWS         As Worksheet, _
    sWB         As Workbook, _
    sWS         As Worksheet, _
    rowx        As Long, _
    sLR         As Long, _
    i           As Long, _
    trial       As VbMsgBoxResult, _
    MaxWB       As Long
    
Set dWB = ActiveWorkbook
Set dWS = dWB.ActiveSheet
rowx = 2
parentdirec = ActiveWorkbook.Path
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With
trial = MsgBox("Would you like to run a test of this macro?", vbYesNo, "Trial Run")
If trial = vbYes Then
    MaxWB = 1010
Else
    MaxWB = 4301
End If
For wbCount = 1001 To MaxWB
    fName = "A" & wbCount & ".xls"
    Application.StatusBar = "Currently opening " & fName
    Workbooks.Open parentdirec & "\" & fName
    Set sWB = Workbooks(fName)
    Set sWS = sWB.Sheets("ClientsRec")
    sLR = sWS.Range("D" & rows.Count).End(xlUp).Row
    For i = 1 To sLR
        Application.StatusBar = "Currently checking row " & i & "/" & sLR & " in " & fName
        If sWS.Range("D" & i).Value >= DateSerial(1990, 10, 10) And sWS.Range("D" & i).Value <= DateSerial(2011, 1, 1) And sWS.Range("S" & i).Value <= 500 Then
            If rowx >= 65530 Then
                dWB.Sheets.Add after:=Sheets(Sheets.Count)
                Set dWS = dWB.ActiveSheet
                rowx = 2
            End If
            sWS.rows(i).Copy Destination:=dWS.Range("A" & rowx)
            rowx = rowx + 1
        End If
    Next i
    Application.StatusBar = "Currently closing " & fName
    sWB.Close
Next wbCount
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .StatusBar = False
End With
End Sub

Also, I'm working on heavily commenting the code so it can be understood.

 

[thunder_anger]

it works great