Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sum specific column rows based on 2 different column criteria | Excel Worksheet Functions | |||
Countings rows based on column criteria | Excel Discussion (Misc queries) | |||
Code help, delete rows based on column criteria | Excel Discussion (Misc queries) | |||
Copying whole rows based upon one criteria | Excel Discussion (Misc queries) | |||
Deleting entire rows based on certain criteria | Excel Programming |