VBA Extract Matching Data from Worksheet Named Range

[msquared99]

I have over 60 workbooks and each contains a named range called "Accruals". The named range spans from column A to column K but the start row and end row will be different in each workbook. For instance the named range is variable in each workbook A24:K52 or A26:K31 or A28:K44 and so on. The only thing that is consistent in each workbook is the named range "Accruals". There is data above and below the named range. In the named range "Accruals" columns A and B contain dates, columns C, E, G, I and K contain numbers. Above the named range in column A there is also some dates.

Looping through all the workbooks is not an issue. What I am trying to do is have a macro ask for a start and end date, look in column A of the named range "Accruals" for any dates between the start and end date and copy the matching row data to a summary workbook.

For instance I enter a date range of 6/1/2015 to 6/30/2015, the macro will look in the named range "Accruals", if a date between the start and end date if found in say row 34 or whatever row, it will copy the data from cells A34 or found row number and G34 or found row number into the summary workbook. The name of the workbook is in cell A2 of all the workbooks and I am looking to put that in the summary workbook as well.

Can someone steer me in the right direction?

I have both the start and end dates using an inputbox. It is the For/If loop that is getting me.

[mancubus]

try below. file name to column A, rows to column B
i assume named ranges dont have a header row.



Sub vbax_53301_pull_data_from_wbs_on_condition()

Dim wb As Workbook, SummaryWS As Worksheet
Dim calc As Long, StartDate As Long, EndDate As Long
Dim FName As String

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

Set SummaryWS = ThisWorkbook.Worksheets("Summary") 'change ws name to suit
StartDate = Application.InputBox(Prompt:="Please enter start date in 'MM/DD/YY' format", Type:=1)
EndDate = Application.InputBox(Prompt:="Please enter end date in 'MM/DD/YY' format", Type:=1)
FName = Dir("C:\MyFolder\*.xls*") 'change folder name to suit

Do While Len(FName) > 0
Set wb = Workbooks.Open(FName)
For i = (Range("Accruals").Rows(1).Row) To (Range("Accruals").Rows(1).Row + Range("Accruals").Rows.Count - 1)
If Cells(i, 1) >= StartDate And Cells(i, 1) <= EndDate Then
SummaryWS.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Range("A2").Value
Rows(i).Copy Destination:=SummaryWS.Cells(Rows.Count, 2).End(xlUp).Offset(1)
End If
Next i
wb.Close False
FName = Dir
Loop

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

[msquared99]

Thanks for your help mancubus!

I am getting a Run-time error 1004 on his line of code:


Rows(i).Copy Destination:=SummaryWS.Cells(Rows.Count, 2).End(xlUp).Offset(1)

I noticed that the Rows.Count part is equal to 65536.

Could it possibly be that the summary workbook is .xlsx and the source workbook is .xls?
Also, the workbooks in the folder to be processed are a mixed bag of .xls and .xlsx