Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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 "James" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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" wrote: 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" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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" wrote: 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" wrote: 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" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
find and copy from a list
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. "JLGWhiz" wrote: 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" wrote: 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" wrote: 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" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy and pasting a find all list into another column | Excel Discussion (Misc queries) | |||
list 1 has 400 names List 2 has 4000. find manes from list 1 on 2 | Excel Worksheet Functions | |||
How to generate a file copy of the Excel Find results list | Excel Programming | |||
how to find and copy values on sheet 2, based on a list on sheet 1 | Excel Programming | |||
Find a list of special characters and copy the entire row where th | Excel Programming |