Copying an entire row or Rows based on column criteria
 

I have four workbooks. The master workbook has a file name of MPF.xls Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook when
specific criteria is met. I want to copy the rows when column 5 = Robin and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook when
specific criteria is met. I want to copy the rows when column 5 = Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

further assumes data starts in Cell A1 (first header in A1, first data value
in A2) and that all workbooks either contain a single sheet or the sheet
with the data to be copied is in the first sheet in the tab order of the
workbook.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook
when
specific criteria is met. I want to copy the rows when column 5 = Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Thanks

I have only one problem. It is copy all the rows regardless of the criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook when
specific criteria is met. I want to copy the rows when column 5 = Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

That would be because at least one of your workbooks have no records that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook
when
specific criteria is met. I want to copy the rows when column 5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Tom

I truly thank you for your help. This works, however, I need it to select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook
when
specific criteria is met. I want to copy the rows when column 5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers are
in row 1 and the data starts in A2 and expands to the right and down? How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column 5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Sir

Correct. I want to be able to copy the row if column 5 contains Robin or
column 9 contains Daycare. Each workbook contains has only one sheet with
column headers in row one and data in row 2 expanding to the right and down.
There are 20 column and remains constant. You can temporarily add a column.
Thanks Bill

"Tom Ogilvy" wrote:

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers are
in row 1 and the data starts in A2 and expands to the right and down? How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column 5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

This should do what you ask. I also put in two variables, col5 and col9 and
assigned them the values of Robin and Daycare respectively. You can change
those if you want a different combination.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
Dim col5 As String, rngA As Range
Dim col9 As String
col5 = "Robin" '<== put in column 5 value
col9 = "daycare" ' <== put in column 9 value

v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
With wkbk.Worksheets(1)
Set rngA = .Cells(1, "IV").End(xlToLeft)
If rngA.Column < 20 Then
Set rngA = .Cells(2, 21)
Else
Set rngA = rngA.Offset(1, 1)
End If
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngA = rngA.Resize(lastrow - 1, 1)
rngA.Formula = "=if(or(E2=""" & col5 & """,I2=""" & _
col9 & """),""copy"",""no copy"")"
rngA(0).Value = "HEADER21"
End With
Set rng = DataRange(wkbk, rngA.Column)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
rngA.EntireColumn.ClearContents
Next
End Sub

Function DataRange(bk As Workbook, col As Long) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=col, Criteria1:="copy"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

--
Regards,
Tom Ogilvy

"Bill" wrote in message
...
Sir

Correct. I want to be able to copy the row if column 5 contains Robin or
column 9 contains Daycare. Each workbook contains has only one sheet with
column headers in row one and data in row 2 expanding to the right and
down.
There are 20 column and remains constant. You can temporarily add a
column.
Thanks Bill

"Tom Ogilvy" wrote:

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers
are
in row 1 and the data starts in A2 and expands to the right and down?
How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to
select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of
the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid
out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the
other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column
5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Sir

I get a Run-time error "1004". The following line is highlighted in yellow.

Set rngA = rngA.Resize(lastrow - 1, 1)

Thanks Bill

"Tom Ogilvy" wrote:

This should do what you ask. I also put in two variables, col5 and col9 and
assigned them the values of Robin and Daycare respectively. You can change
those if you want a different combination.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
Dim col5 As String, rngA As Range
Dim col9 As String
col5 = "Robin" '<== put in column 5 value
col9 = "daycare" ' <== put in column 9 value

v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
With wkbk.Worksheets(1)
Set rngA = .Cells(1, "IV").End(xlToLeft)
If rngA.Column < 20 Then
Set rngA = .Cells(2, 21)
Else
Set rngA = rngA.Offset(1, 1)
End If
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngA = rngA.Resize(lastrow - 1, 1)
rngA.Formula = "=if(or(E2=""" & col5 & """,I2=""" & _
col9 & """),""copy"",""no copy"")"
rngA(0).Value = "HEADER21"
End With
Set rng = DataRange(wkbk, rngA.Column)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
rngA.EntireColumn.ClearContents
Next
End Sub

Function DataRange(bk As Workbook, col As Long) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=col, Criteria1:="copy"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

--
Regards,
Tom Ogilvy

"Bill" wrote in message
...
Sir

Correct. I want to be able to copy the row if column 5 contains Robin or
column 9 contains Daycare. Each workbook contains has only one sheet with
column headers in row one and data in row 2 expanding to the right and
down.
There are 20 column and remains constant. You can temporarily add a
column.
Thanks Bill

"Tom Ogilvy" wrote:

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers
are
in row 1 and the data starts in A2 and expands to the right and down?
How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to
select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of
the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid
out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the
other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column
5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Tom

Thanks a million. It works great.

Bill

"Tom Ogilvy" wrote:

This should do what you ask. I also put in two variables, col5 and col9 and
assigned them the values of Robin and Daycare respectively. You can change
those if you want a different combination.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
Dim col5 As String, rngA As Range
Dim col9 As String
col5 = "Robin" '<== put in column 5 value
col9 = "daycare" ' <== put in column 9 value

v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
With wkbk.Worksheets(1)
Set rngA = .Cells(1, "IV").End(xlToLeft)
If rngA.Column < 20 Then
Set rngA = .Cells(2, 21)
Else
Set rngA = rngA.Offset(1, 1)
End If
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngA = rngA.Resize(lastrow - 1, 1)
rngA.Formula = "=if(or(E2=""" & col5 & """,I2=""" & _
col9 & """),""copy"",""no copy"")"
rngA(0).Value = "HEADER21"
End With
Set rng = DataRange(wkbk, rngA.Column)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
rngA.EntireColumn.ClearContents
Next
End Sub

Function DataRange(bk As Workbook, col As Long) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=col, Criteria1:="copy"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

--
Regards,
Tom Ogilvy

"Bill" wrote in message
...
Sir

Correct. I want to be able to copy the row if column 5 contains Robin or
column 9 contains Daycare. Each workbook contains has only one sheet with
column headers in row one and data in row 2 expanding to the right and
down.
There are 20 column and remains constant. You can temporarily add a
column.
Thanks Bill

"Tom Ogilvy" wrote:

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers
are
in row 1 and the data starts in A2 and expands to the right and down?
How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to
select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of
the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid
out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the
other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column
5 =
Robin
and
or Column 9 = Daycare.

Copying an entire row or Rows based on column criteria
 

Tom

Can you help me with this one.

I have two worksheets containing rows of data. I need the VBA code that will
scan column g on the worksheet named "MSO Tracking". When the scan
encounters a date older than todays date then I need the entire row starting
from Column B move to a worksheet named "Completed MSO" in the same
workbook. The row in the worksheet named "MSO Tracking" should then be
delete. Please help.


"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid out as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the other three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master workbook when
specific criteria is met. I want to copy the rows when column 5 = Robin
and
or Column 9 = Daycare.