Help with my VBA

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

James - 25 Jul 2008 19:20 GMT

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 to this Message

Jim Thomlinson - 25 Jul 2008 20:33 GMT

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

Signature

HTH...

Jim Thomlinson

> 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
[quoted text clipped - 40 lines]
>
> Thank you, as always

Reply to this Message

James - 25 Jul 2008 20:42 GMT

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

> 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
[quoted text clipped - 55 lines]
> >
> > Thank you, as always

Reply to this Message

Jim Thomlinson - 25 Jul 2008 20:55 GMT

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

Signature

HTH...

Jim Thomlinson

> Jim,
> Thanks for the assistance, your idea works and it will do for now. However
[quoted text clipped - 63 lines]
> > >
> > > Thank you, as always

Reply to this Message

James - 25 Jul 2008 21:51 GMT

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

> 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
[quoted text clipped - 78 lines]
> > > >
> > > > Thank you, as always

Reply to this Message

Jim Thomlinson - 25 Jul 2008 23:01 GMT

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

Signature

HTH...

Jim Thomlinson

Reply to this Message