Excel Search and Copy macroClosed

Question

Hello,

I have a large spreadsheet generated by Blast, a program for determining similarity of genetic sequences.  I am interested in copying out only the genes which are unique.  For each gene, there is line of text that reports the number of hits in the search.  I need a way to search for and identify the rows that contain only one hit (The exact text string is "# 1 hits found") and then to copy that row AND the surrounding rows to a new worksheet.  (There are about 200 unique hits in the spreadsheet and over 36000 rows).

Example if row 17 is a unique hit then I also need to copy 14, 15, 16, and 18.  These other rows contain information about the gene (gene name, Blast score, etc) that I also want to keep.

I have no idea how to do this, it's a bit out of my league.  If anyone has any suggestions, please help...

venkat1926 · Answer

I suppose your data is something like this 

gene_code	hits 

a	
s	
d	
f	
g	# 1 hits found
h	
j	
k	
l	# 1 hits found
m	
n	
your source sheet is called sheet1 and the destination sheet is called sheet2
It would have been nicer if you had just entered 1, 2, 3 etc in the hits column.But you have put a string # 1 hits found.  in that case you have to be very careful in spelling  not only in the sheet1 but also in the macro below against the definition of x. Even if there is unnecessary space anywhere will mess up the results. 

anyhow try this macro 

Sub test()
Dim r As Range, cfind As Range, x, add As String
x = "# 1 hits found"
On Error Resume Next
With Worksheets("sheet1")
Set r = Range(.Range("B2"), .Range("B2").End(xlDown))
Set cfind = r.Cells.Find(what:=x, lookat:=xlWhole)
If Not cfind Is Nothing Then
Range(cfind.Offset(-3, 0), cfind.Offset(1, 0)).EntireRow.Copy
add = cfind.Address
With Worksheets("sheet2")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
End If
Do
Set cfind = .Cells.FindNext(cfind)
If cfind Is Nothing Then Exit Do
If cfind.Address = add Then Exit Do
With Worksheets("sheet2")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With

Loop
End With
Application.CutCopyMode = False
End Sub

Excel Search and Copy macro

1 response

Similar discussions

Subscribe To Our Newsletter!