find and copy from a list

[James]

I need some help with this code that I was able to piece together. I am
trying to get it to look at a list on Sheet 1 all names are in column A and
search for those names on my data source worksheet, from there I would like
to get it to copy the data onto worksheet 2.

I have managed to get it to search on an indivdual name just fine but I am
having a hard time to get it to search with my list that is on Sheet1.
My workbook is set up like this
Sheet1 - Has the list of names that I want to search for
Sheet2 - DestSheet (where the data is copied to)
Sheet3 - Has all the data

Below is my code:

Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range

With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), .Cells(Rows.Count, "A").End(xlUp))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
End Sub


Public Sub CopyNames(ByVal strName As String)
'Sub CopyNames()
'col Name of the active worksheet (source sheet) to cols
'A to Z of Sheet2 (destination sheet)
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long


sCount = 0
dRow = 1

For sRow = 1 To Range("D65536").End(xlUp).Row
'use pattern matching to find "Name" anywhere in cell

If Cells(sRow, "A") Like "*" & strName & "*" Then

'If Cells(sRow, "A") Like "*Pena*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A to Z
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "B")
Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow, "C")
Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "F")
Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "G")
Cells(sRow, "H").Copy Destination:=DestSheet.Cells(dRow, "H")
Cells(sRow, "I").Copy Destination:=DestSheet.Cells(dRow, "I")
End If
Next sRow

MsgBox sCount & " rows copied", vbInformation, "Transfer Done"

End Sub

Thanks for the help

 

[JLGWhiz]

See if the modifications below help any.


Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range

With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), .Range("A" & .Cells(Rows.Count,
"A").End(xlUp))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
Next
End Sub

 

[JLGWhiz]

Get rid of the line wrap.

Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range

With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), _
.Range("A" & .Cells(Rows.Count, "A").End(xlUp))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
Next
End Sub

 

[James]

Thanks for the quick response, I saw the line wrap issue but I am still
getting an error as listed below:

Compile error:
Expected: list separator or )

I added a ")" to the end of the xlUp))

Set rngNames = .Range(.Range("A1"), .Range("A" & .Cells(Rows.Count,
"A").End(xlUp)))

But i still get an error
Run-time error '1004'
Application-defined or object-defined error


Thanks again.

 

[JLGWhiz]

Yep, I blame these things on having a senior moment. Needed .Row
It should run now. But I don't know if your variable value will carry to
the called macro or not. You can work on that.

Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range
With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), _
..Range("A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
Next
End Sub

 

[James]

Thank you so much, the variable actually did carry to the called macro but it
is now overwritting what are in the list. Such as it goes and finds, my
first entry and copies it to Sheet2 but when it looks for the 2nd entry it
finds it and copies over what is in there already.

How can I make it put the entries after each other and avoid copying over
the initial entries.

Thanks again.