I’m trying to copy selected rows from sheet Official List to paste in
sheet Contact Report. A Userform asks user to give a value. This value
is assigned name of FindContact in the UserForm. This value will be
located multiple times in a column of Official List. I’ve named this
column ContactRange.
The problem I’m having is finding and selecting each of these rows
that contain the variable. I want this to select each row containing
the FindContact value, then copy it to the sheet named Contact Report.
I’ve been fumbling around, trying to get the Do Until, For Each syntax
correct as you can see below. I’m sure I’m messing up something
simple. Maybe I’m using the wrong approach, so any help would be
appreciated.
Thanks, jeff.

Sub SelectContacts()

Dim FindContact As String

Worksheets("Official List").Activate ‘source sheet
Application.Goto Reference:="ContactOfficialList" ‘this is name given
to column header
ActiveCell.Offset(1, 0).Range("A1").Select ‘goes down to 1st row of
list

‘to loop through the list until empty cell is found, which will be the
end of the list.
Do Until IsEmpty(ActiveCell.Value)

For Each cell In Range("ContactRange")
If cell.Value = FindContact Then
Rows(ActiveCell.Row).Select
Selection.Copy

'Goes to Contact Report folder to paste record in next empty row.
Worksheets("Contact Report").Activate
Range("B65536").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste

End If
Exit For
ActiveCell.Offset(1, 0).Select ‘moves down to check the next row.

‘After the errors, I tried to change all this around, trying to
stumble on the correct syntax.
Loop
‘Next
'Exit Do

End Sub

On Aug 27, 2:40*pm, wrote:
I’m trying to copy selected rows from sheet Official List to paste in
sheet Contact Report. A Userform asks user to give a value. This value
is assigned name of FindContact in the UserForm. This value will be
located multiple times in a column of Official List. I’ve named this
column ContactRange.
The problem I’m having is finding and selecting each of these rows
that contain the variable. I want this to select each row containing
the FindContact value, then copy it to the sheet named Contact Report.
I’ve been fumbling around, trying to get the Do Until, For Each syntax
correct as you can see below. I’m sure I’m messing up something
simple. Maybe I’m using the wrong approach, so any help would be
appreciated.
Thanks, jeff.

Sub SelectContacts()

Dim FindContact As String

Worksheets("Official List").Activate *‘source sheet
Application.Goto Reference:="ContactOfficialList" ‘this is name given
to column header
ActiveCell.Offset(1, 0).Range("A1").Select * ‘goes down to 1st row of
list

‘to loop through the list until empty cell is found, which will be the
end of the list.
Do Until IsEmpty(ActiveCell.Value)

For Each cell In Range("ContactRange")
* * * If cell.Value = FindContact Then
Rows(ActiveCell.Row).Select
Selection.Copy

'Goes to Contact Report folder to paste record in next empty row.
Worksheets("Contact Report").Activate
Range("B65536").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste

End If
Exit For
ActiveCell.Offset(1, 0).Select ‘moves down to check the next row.

‘After the errors, I tried to change all this around, trying to
stumble on the correct syntax.
Loop
‘Next
'Exit Do

End Sub

You'll need the 'Next' statement before the Loop statement for
starters.

Assuming that your variable FindContact has a valid value, this should
check each cell in the Contact Range, and if it finds a match, copy it
to the Contact Report sheet to the next empty row. Watch line wrap if
copying.

Sub copyContact()
dim c As Range, lc As Long
For Each c In Range("Contact Range")
If c.Value = FindContact Then
lc = Cells(c.Row, Columns.Count).End(xlToLeft).Column
Sheets("Official List").Range(Cells(c.Row, 1), Cells(c.Row, lc)).Copy _
Sheets("Contact Report").Range("B65536").End(xlUp).Offset(1, -1)
End If
Next
End Sub

" wrote:

Im trying to copy selected rows from sheet Official List to paste in
sheet Contact Report. A Userform asks user to give a value. This value
is assigned name of FindContact in the UserForm. This value will be
located multiple times in a column of Official List. Ive named this
column ContactRange.
The problem Im having is finding and selecting each of these rows
that contain the variable. I want this to select each row containing
the FindContact value, then copy it to the sheet named Contact Report.
Ive been fumbling around, trying to get the Do Until, For Each syntax
correct as you can see below. Im sure Im messing up something
simple. Maybe Im using the wrong approach, so any help would be
appreciated.
Thanks, jeff.

Sub SelectContacts()

Dim FindContact As String

Worksheets("Official List").Activate €˜source sheet
Application.Goto Reference:="ContactOfficialList" €˜this is name given
to column header
ActiveCell.Offset(1, 0).Range("A1").Select €˜goes down to 1st row of
list

€˜to loop through the list until empty cell is found, which will be the
end of the list.
Do Until IsEmpty(ActiveCell.Value)

For Each cell In Range("ContactRange")
If cell.Value = FindContact Then
Rows(ActiveCell.Row).Select
Selection.Copy

'Goes to Contact Report folder to paste record in next empty row.
Worksheets("Contact Report").Activate
Range("B65536").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste

End If
Exit For
ActiveCell.Offset(1, 0).Select €˜moves down to check the next row.

€˜After the errors, I tried to change all this around, trying to
stumble on the correct syntax.
Loop
€˜Next
'Exit Do

End Sub

I was just thinking that if you have formulas in any of the cells you are
copying, you should use paste special if you only want the values for those
cells in the destination sheet.

" wrote:

Im trying to copy selected rows from sheet Official List to paste in
sheet Contact Report. A Userform asks user to give a value. This value
is assigned name of FindContact in the UserForm. This value will be
located multiple times in a column of Official List. Ive named this
column ContactRange.
The problem Im having is finding and selecting each of these rows
that contain the variable. I want this to select each row containing
the FindContact value, then copy it to the sheet named Contact Report.
Ive been fumbling around, trying to get the Do Until, For Each syntax
correct as you can see below. Im sure Im messing up something
simple. Maybe Im using the wrong approach, so any help would be
appreciated.
Thanks, jeff.

Sub SelectContacts()

Dim FindContact As String

Worksheets("Official List").Activate €˜source sheet
Application.Goto Reference:="ContactOfficialList" €˜this is name given
to column header
ActiveCell.Offset(1, 0).Range("A1").Select €˜goes down to 1st row of
list

€˜to loop through the list until empty cell is found, which will be the
end of the list.
Do Until IsEmpty(ActiveCell.Value)

For Each cell In Range("ContactRange")
If cell.Value = FindContact Then
Rows(ActiveCell.Row).Select
Selection.Copy

'Goes to Contact Report folder to paste record in next empty row.
Worksheets("Contact Report").Activate
Range("B65536").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste

End If
Exit For
ActiveCell.Offset(1, 0).Select €˜moves down to check the next row.

€˜After the errors, I tried to change all this around, trying to
stumble on the correct syntax.
Loop
€˜Next
'Exit Do

End Sub