Solved

Formula to copy paste values from one sheet to another based on cell value

Posted on 2013-11-11
7
1,376 Views
Last Modified: 2013-11-12
I need help with the following.  I need a way to find only rows that match a value in a cell on another sheet then copy all the matching rows and columns with the matching value to another sheet.  Thanks in advance.

If Sheet1 value  in B2 = Sheet2 value in A5:D1000 then
copy all rows and columns to Sheet3

and if Sheet1 value not on Sheet2 do a search n Sheet4 and copy those values...
0
Comment
Question by:leezac
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
7 Comments
 
LVL 81

Expert Comment

by:byundt
ID: 39640508
This is really a job for a macro rather than a formula.

The following macro inserts an empty column in Sheet2 column A and puts a COUNTIF formula that tests whether each row in A5:D1000 contains an instance of the value in Sheet1 cell B2. Sheet2 is then AutoFiltered on column A, looking for TRUE. If no values are found, then the process is repeated with Sheet4. If one or more TRUE are found, the original data on those row(s) are copied to bottom of Sheet3. The macro then cleans up by deleting column A and removing the AutoFilter.
Sub CopyMatic()
Dim rgCopy As Range, rgData As Range, rgDest As Range, rgFilt As Range, rgTest As Range, targ As Range
Dim vSheet As Variant
Dim bFinished As Boolean
Application.ScreenUpdating = False
Set targ = Worksheets("Sheet1").Range("B2")
With Worksheets("Sheet3")
    Set rgDest = .UsedRange
    Set rgDest = rgDest.Rows(rgDest.Rows.Count).EntireRow
    If Application.CountA(rgDest) > 0 Then Set rgDest = rgDest.Offset(1, 0)
End With
For Each vSheet In Array("Sheet2", "Sheet4")    'List as many sheets to check as you like
    With Worksheets(vSheet)
        Set rgFilt = .Range("A5:D1000")
        Set rgData = Intersect(rgFilt.EntireRow, .UsedRange)
        .Columns(1).Insert
        Set rgTest = rgFilt.Columns(1).Offset(0, -1)
        rgTest.FormulaR1C1 = "=COUNTIF(RC[1]:RC[4],""" & targ.Value & """)>0"
        'rgTest.EntireRow.Sort Key1:=rgTest.Cells(1), Order1:=xlDescending, Header:=xlNo
        rgTest.Offset(-1, 0).EntireRow.AutoFilter Field:=1, Criteria1:="TRUE"
        Set rgCopy = Nothing
        On Error Resume Next
        Set rgCopy = rgTest.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rgCopy Is Nothing Then
            Set rgCopy = Intersect(rgCopy.EntireRow, rgData)
            rgCopy.Copy
            rgDest.PasteSpecial xlPasteValuesAndNumberFormats
            bFinished = True
        End If
        rgTest.Offset(-1, 0).Cells(1, 1).AutoFilter
        rgTest.EntireColumn.Delete
        If bFinished Then Exit For
    End With
Next
End Sub

Open in new window

CopyMaticQ28291348.xlsm
0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 39641429
Sounds like you might be looking for a lookup type formula, whether you use a VLOOKUP or INDEX/MATCH combination.

Are you able to supply some sample data?

Thanks
Rob H
0
 
LVL 81

Expert Comment

by:byundt
ID: 39641466
I suppose that you could bring back the data with an array formula in Sheet3 cell A1 like:
=IFERROR(IF(COUNTIF(Sheet2!$A$5:$D$1000,Sheet1!$B$2)>0,INDEX(Sheet2!$A$5:$Z$1000,SMALL(IF(Sheet2!$A$5:$D$1000=Sheet1!$B$2,ROW(Sheet2!$A$5:$D$1000)-ROW(Sheet2!$A$5)+1,""),ROW()),COLUMN()),INDEX(Sheet4!$A$5:$Z$1000,SMALL(IF(Sheet4!$A$5:$D$1000=Sheet1!$B$2,ROW(Sheet4!$A$5:$D$1000)-ROW(Sheet4!$A$5)+1,""),ROW()),COLUMN())),"")

But doing so would be computationally intensive and any blank cells would be returned as 0.

I still think it is a job for a macro.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:leezac
ID: 39641943
I am reviewing the macro now
0
 

Author Comment

by:leezac
ID: 39642251
Ok - I am adding a file with same and the code for the Macro from byundt now.  I like the way the filter works but it does not seem to look at Sheet4 if not on Sheet 2.  I am not sure what the copy paste is doing, but will eventually copy the filtered rows to a new sheet.

For now though how I need is below:

If the number in B2 of Sheet one is found on Sheet2, then filter all rows else look at Sheet4

I have two values to work with - 6 is not on Sheet2 but is on Sheet4 and 21 is on both sheets, but just want to copy if on Sheet2.

Thank you!
0
 
LVL 81

Accepted Solution

by:
byundt earned 500 total points
ID: 39642347
I'm not reproducing your problem.

In the sample workbook attached:
"abc" is only in Sheet4 cells A5:D1000
"def" is only in Sheet2 cells A5:D1000
"ghi" is present on both Sheet2 and Sheet4, but not in A5:D1000
"jkl" is present in both Sheet2 and Sheet4 cells A5:D1000

If you run the macro four times, you will see Sheet4 data with "abc", Sheet2 data with "def" and "jkl", and no results returned with "ghi"
Sub CopyMatic()
Dim rgCopy As Range, rgData As Range, rgDest As Range, rgFilt As Range, rgTest As Range, targ As Range
Dim vSheet As Variant
Dim bFinished As Boolean
Application.ScreenUpdating = False
Set targ = Worksheets("Sheet1").Range("B2")
With Worksheets("Sheet3")
    Set rgDest = .UsedRange
    Set rgDest = rgDest.Rows(rgDest.Rows.Count).EntireRow
    If Application.CountA(rgDest) > 0 Then Set rgDest = rgDest.Offset(1, 0)
End With
For Each vSheet In Array("Sheet2", "Sheet4")    'List as many sheets to check as you like
    With Worksheets(vSheet)
        Set rgFilt = .Range("A5:D1000")
        Set rgData = Intersect(rgFilt.EntireRow, .UsedRange)
        .Columns(1).Insert
        Set rgTest = rgFilt.Columns(1).Offset(0, -1)
        rgTest.FormulaR1C1 = "=COUNTIF(RC[1]:RC[4],""" & targ.Value & """)>0"
        'rgTest.EntireRow.Sort Key1:=rgTest.Cells(1), Order1:=xlDescending, Header:=xlNo
        rgTest.Offset(-1, 0).EntireRow.AutoFilter Field:=1, Criteria1:="TRUE"
        Set rgCopy = Nothing
        On Error Resume Next
        Set rgCopy = rgTest.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rgCopy Is Nothing Then
            Set rgCopy = Intersect(rgCopy.EntireRow, rgData)
            rgCopy.Copy
            rgDest.PasteSpecial xlPasteValuesAndNumberFormats
            bFinished = True
        End If
        rgTest.Offset(-1, 0).Cells(1, 1).AutoFilter
        rgTest.EntireColumn.Delete
        If bFinished Then Exit For
    End With
Next
End Sub

Open in new window

CopyMaticQ28291348.xlsm
0
 

Author Closing Comment

by:leezac
ID: 39642756
OK - I got it thanks!!!
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

696 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question