• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1505
  • Last Modified:

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

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
leezac
Asked:
leezac
  • 3
  • 3
1 Solution
 
byundtCommented:
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
 
Rob HensonFinance AnalystCommented:
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
 
byundtCommented:
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
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

 
leezacAuthor Commented:
I am reviewing the macro now
0
 
leezacAuthor Commented:
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
 
byundtCommented:
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
 
leezacAuthor Commented:
OK - I got it thanks!!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now