Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
I have the following code and what it does is find the name "James" in this
example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
The easiest thing to do is to add a parameter to the procedure which is the
name you are looking for. Then call the procedure repeatedly with different names... Sub CopyAllNames call Sub CopyNames("James") call Sub CopyNames("John") end sub public sub CopyNames(byval strName as string) '... If Cells(sRow, "A") Like "*" & strname & "*" Then '... end sub -- HTH... Jim Thomlinson "James" wrote: I have the following code and what it does is find the name "James" in this example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
Jim,
Thanks for the assistance, your idea works and it will do for now. However I was trying to come up with something that I do not have to type in, I tried a few other things all with no much success but your idea does work but will have to change every time I get a new list of names. Thanks "Jim Thomlinson" wrote: The easiest thing to do is to add a parameter to the procedure which is the name you are looking for. Then call the procedure repeatedly with different names... Sub CopyAllNames call Sub CopyNames("James") call Sub CopyNames("John") end sub public sub CopyNames(byval strName as string) '... If Cells(sRow, "A") Like "*" & strname & "*" Then '... end sub -- HTH... Jim Thomlinson "James" wrote: I have the following code and what it does is find the name "James" in this example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
Put your list of names in a sheet and itterate through the cells picking up
the names something like this. It assumes the list of names is in sheet1 cells A2:A?? Sub CopyAllNames dim rng as range dim rngNames as range with sheets("Sheet1") set rngnames = .range(.range("A2"), .cells(rows.count, "A").end(xlup)) end with for each rng in rngnames call Sub CopyNames(rng.value) end sub -- HTH... Jim Thomlinson "James" wrote: Jim, Thanks for the assistance, your idea works and it will do for now. However I was trying to come up with something that I do not have to type in, I tried a few other things all with no much success but your idea does work but will have to change every time I get a new list of names. Thanks "Jim Thomlinson" wrote: The easiest thing to do is to add a parameter to the procedure which is the name you are looking for. Then call the procedure repeatedly with different names... Sub CopyAllNames call Sub CopyNames("James") call Sub CopyNames("John") end sub public sub CopyNames(byval strName as string) '... If Cells(sRow, "A") Like "*" & strname & "*" Then '... end sub -- HTH... Jim Thomlinson "James" wrote: I have the following code and what it does is find the name "James" in this example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
Jim,
First thanks for looking at my code. I tries inserting your code as well but I cannot get it to work. Can you take a look at it and let me know what is wrong with it. Here is what I have now Sub CopyAllNames() Dim rng As Range Dim rngNames As Range With Sheets("Sheet3") Set rngNames = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp)) End With For Each rng In rngNames call Sub CopyNames(rng.value) End Sub 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 "*James*" 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 "Jim Thomlinson" wrote: Put your list of names in a sheet and itterate through the cells picking up the names something like this. It assumes the list of names is in sheet1 cells A2:A?? Sub CopyAllNames dim rng as range dim rngNames as range with sheets("Sheet1") set rngnames = .range(.range("A2"), .cells(rows.count, "A").end(xlup)) end with for each rng in rngnames call Sub CopyNames(rng.value) end sub -- HTH... Jim Thomlinson "James" wrote: Jim, Thanks for the assistance, your idea works and it will do for now. However I was trying to come up with something that I do not have to type in, I tried a few other things all with no much success but your idea does work but will have to change every time I get a new list of names. Thanks "Jim Thomlinson" wrote: The easiest thing to do is to add a parameter to the procedure which is the name you are looking for. Then call the procedure repeatedly with different names... Sub CopyAllNames call Sub CopyNames("James") call Sub CopyNames("John") end sub public sub CopyNames(byval strName as string) '... If Cells(sRow, "A") Like "*" & strname & "*" Then '... end sub -- HTH... Jim Thomlinson "James" wrote: I have the following code and what it does is find the name "James" in this example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with my VBA
Oops.. Remove the word sub...
Sub CopyAllNames dim rng as range dim rngNames as range with sheets("Sheet1") set rngnames = .range(.range("A2"), .cells(rows.count, "A").end(xlup)) end with for each rng in rngnames call CopyNames(rng.value) end sub -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: Put your list of names in a sheet and itterate through the cells picking up the names something like this. It assumes the list of names is in sheet1 cells A2:A?? Sub CopyAllNames dim rng as range dim rngNames as range with sheets("Sheet1") set rngnames = .range(.range("A2"), .cells(rows.count, "A").end(xlup)) end with for each rng in rngnames call Sub CopyNames(rng.value) end sub -- HTH... Jim Thomlinson "James" wrote: Jim, Thanks for the assistance, your idea works and it will do for now. However I was trying to come up with something that I do not have to type in, I tried a few other things all with no much success but your idea does work but will have to change every time I get a new list of names. Thanks "Jim Thomlinson" wrote: The easiest thing to do is to add a parameter to the procedure which is the name you are looking for. Then call the procedure repeatedly with different names... Sub CopyAllNames call Sub CopyNames("James") call Sub CopyNames("John") end sub public sub CopyNames(byval strName as string) '... If Cells(sRow, "A") Like "*" & strname & "*" Then '... end sub -- HTH... Jim Thomlinson "James" wrote: I have the following code and what it does is find the name "James" in this example and copies all the information that is associated on that row and places it on Sheet2. I need this code to be a little more flexiable, but cannot figure out how to have it look through a list of names that is on Sheet3 in column A starting in row1. I will have anywhere between 10 to 20 names and would like this Macro to run through that list of names that is on Sheet3. I hope I have explained this well enough, if not let me know 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 "*James*" 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 Thank you, as always |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|