VBA Question

chrono2483

Board Regular
Joined
Aug 23, 2014
Messages
159
Hello,

I am looking for help with a scrip. A play off of the following script if possible that would copy the cell, instead of delete the row:

Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A5000").End(xlUp))
Do
Set myCell = SrchRng.Find("Agent", LookIn:=xlValues)
If Not myCell Is Nothing Then myCell.EntireRow.Delete
Loop While Not myCell Is Nothing


But instead of deleting the row, it would copy the cell, and paste elsewhere - and because its a loop, continue to find all the cells within that range with "Agent" and continue to paste elsewhere.

Can someone help with this?
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,193
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
The first step would be to change:
myCell.EntireRow.Delete
to:
myCell.Copy

then decide where and how you want to paste the copy.
 

chrono2483

Board Regular
Joined
Aug 23, 2014
Messages
159
Thanks! From here, if loop is on, it will continue to copy the next similar word. How do I paste it so that each copied cell is pasted under the next? (IE. M3, M4, M5, etc until complete)

I've tried to put together this script, but it only copies/pastes the first word, rather than continuing to search for additional specified words

Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A1000").End(xlUp))
Do
Set myCell = SrchRng.Find("Name", LookIn:=xlValues)
If Not myCell Is Nothing Then myCell.Copy
Range("M3:M100" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row).Select
ActiveSheet.Paste
Loop While Not myCell Is Nothing


What changes would I need to make, so that it continues to loop, and continues to copy/paste in column M?
 
Last edited:

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,193
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Dim i as long, firstAddress as string
Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A5000").End(xlUp))
Set myCell = SrchRng.Find("Agent", LookIn:=xlValues)
If Not myCell Is Nothing Then
firstAddress=myCell.Address
i=22
mycell.Copy Cells(i,1)
Else
Msgbox "Can't find search string"
Exit Sub
End If
Do
set myCell = SrchRng.FindNext(myCell)
If myCell is Nothing then exit do
If myCell.address = firstAddress then Exit Do
i= i + 1
myCell.copy Cells(i,1)
Loop
'rest of code
 
Last edited:

chrono2483

Board Regular
Joined
Aug 23, 2014
Messages
159

ADVERTISEMENT

I seem to get a Runtime error 1004 with that, and in addition, it seems to have skipped the first name, and copied the second name, and pasted it in the same column starting with row 22, replacing existing data, rather than pasting in sequential order in Col M. I am guessing this is due to i=22. I thought by changing it to i=M3 it would work, but doesn't seem to. Is there something else to change?
 
Last edited:

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,193
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I seem to get a Runtime error 1004 with that, and in addition, it seems to have skipped the first name, and copied the second name, and pasted it in the same column starting with row 22, replacing existing data, rather than pasting in sequential order in Col M. I am guessing this is due to i=22. I thought by changing it to i=M3 it would work, but doesn't seem to. Is there something else to change?
To start pasting in M3 and sequentially:

Dim i as long, firstAddress as string
Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A5000").End(xlUp))
Set myCell = SrchRng.Find("Agent", LookIn:=xlValues)
If Not myCell Is Nothing Then
firstAddress=myCell.Address
i=3
mycell.Copy Cells(i,"M")
Else
Msgbox "Can't find search string"
Exit Sub
End If
Do
set myCell = SrchRng.FindNext(myCell)
If myCell is Nothing then exit do
If myCell.address = firstAddress then Exit Do
i= i + 1
myCell.copy Cells(i,"M")
Loop
'rest of code

If you get a run time error, post back with the error message and the line that is highlighted when you select "Debug".
 

Watch MrExcel Video

Forum statistics

Threads
1,108,646
Messages
5,524,060
Members
409,557
Latest member
Excelinho

This Week's Hot Topics

Top