Search for data based on cells in another worksheet and copy data to another wrksht

[jlw8201]

Hello,

Here is what I am trying to accomplish:
Workbook with 3 tabs. "Data", "Names", and "Results".
I want to copy rows of data from the "Data" tab into the "Results" tab. I only want data copied IF there is a matching name on the "Names" tab that is also in the "Data" tab. I have found a macro that will copy the data to the "Results" tab, but only by typing in one name at a time into the code.

How can i search for data and copy it based on names in another worksheet?

I am using Excel 2013
"Names" tab: Names i want to search by are located in column B
"Data" tab: Names i want to match are also located in column B. If the names match, i want to copy the whole row. And there may be more than 1 row with the same name. I want to copy all rows with the matching name. Data extends from columns A:G.
"Results" tab: Data should start on A2.

Thank you in advance for any help, i truly appreciate it!

Here is the Code: (I am just learning, and i appreciate any guidance. This code was copied and adapted from other examples i could find!)
Sub copyToOtherSheet()


Dim srcSheet As Worksheet, dstSheet As Worksheet
Dim lRow As Long
Dim srcRng As Range


' Don't display alert on deletion
Application.DisplayAlerts = True


With ThisWorkbook
' Sheet where we copy from
Set srcSheet = .Sheets("Data")
' Sheet where we copy to
Set dstSheet = .Sheets("Results")
End With


With srcSheet
' Check how many records in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Filter all values with "textvalue" in column B
.Rows(1).AutoFilter 2, "NAME"
' Set copy range
Set srcRng = .Range(.Cells(7, 1), .Cells(lRow, 7))
' Copy visible rows
On Error Resume Next
srcRng.SpecialCells(xlCellTypeVisible).Copy
' If we don't have anything to copy, exit macro
If Err.Number = 1004 Then
MsgBox "No cells to copy!" & vbNewLine & "Exiting macro.", vbInformation
srcSheet.ShowAllData
Application.DisplayAlerts = True
End
End If
On Error GoTo 0
End With

With dstSheet
' Check how many records in already in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Paste records to destionation table
.Cells(lRow + 1, 1).PasteSpecial
End With


' Clear filter
srcSheet.ShowAllData


Application.DisplayAlerts = True

End Sub

[TheLambal]

Guesse this is what you're looking for.
untested because I don't have a sheet but should work

Sub copyToOtherSheet()



Dim srcSheet As Worksheet, dstSheet As Worksheet, nameSheet As Worksheet
Dim lRow As Long
Dim srcRng As Range
Dim i As Long, c As Long, j As Long


' Don't display alert on deletion
Application.DisplayAlerts = False




With ThisWorkbook
' Sheet where we copy from
Set srcSheet = .Sheets("Data")
' Sheet where we copy to
Set dstSheet = .Sheets("Results")
Set dstSheet = .Sheets("Names")
End With


With nameSheet
' Check how many records in table
lRowName = .Cells(Rows.Count, 1).End(xlUp).Row
End With


With srcSheet
' Check how many records in table
lRowSRC = .Cells(Rows.Count, 1).End(xlUp).Row
End With


With dstSheet
' clear last results
lrowdst = .Cells(Rows.Count, 1).End(xlUp).Row
If lrowdst = 1 Then lrowdst = 2 'if there are only headers don't clear them
.Range("A" & 2 & ":G" & lrowdst).ClearContents
End With


'k as counter for row names
'i as counter for rows data
'c as counter colums data
'j as counter for rows results
j = 2 'first row of your results


For k = 1 To lRowName 'loop trough rows with names
Name = Sheets(nameSheet).Range("B" & k).Value 'get cell value from name sheet
    For i = 2 To lRowSRC 'loop trough rows data
        For c = 1 To 7 'loop trough columns data
            cellvalue = Sheets(srcSheet).Cells(i, c)
            If InStr(1, Name, cellvalue, vbBinaryCompare) > 0 Then 'check if name is in cell value
                Sheets(dstSheet).Range("A" & j & ":G" & j) = Sheets(srcSheet).Range("A" & i & ":G" & i) 'copy row to search results
                j = j + 1 'add 1 to counter row results
                GoTo foundrow 'go to next i to stop getting the same result 2 times if name exists in multiple columns
            End If
        Next c
foundrow:
    Next i
Next k






Application.DisplayAlerts = True


End Sub

[p45cal]

We might be able to do this with one line of code (using Advanced Filter) but one or two more lines of code would make it easy to understand.
Supply a workbook with the scenario you describe. - save us getting things wrong.

While it's unlikely to work without a few tweaks that line of code could be on the lines of:

Sheets("Data").Range("A1").currentregion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Names").Range("B1:B5"), CopyToRange:=Sheets("Results").Range("A1"), Unique:=False

and a couple of things need to be in place before it works reliably.

[p45cal]

In the attached, click button on the Data sheet and then look at Results sheet.

[jlw8201]

p45cal - This works perfectly!!!! Thank you so much to you both for helping me!

[jlw8201]

Thank you again for your help. What can i do to modify the code so that no matter how many names there are on the "Names" worksheet, it was search for them all. This will change and can be 1 name or up to 100 names for example. If i change the range for the criteria it copies everything instead of just the names listed on the "Names" worksheet.

Thank you!

[p45cal]

Again, supply a workbook with the scenario you describe, - save us getting things wrong.