Excel - Copy row if a range of column matches a value

October 2016

Microsoft Excel is a very handy tool to play around with data. Excel provides users with the flexibility to record or write their own macro which can be used to automate lengthy and tedious tasks. If the user is trying to copy a row if a range matches a value, then this can be done in such a way where the user can specify the value in a dynamic way. One can use the input box to collect user input and then use a loop where the input value is searched. Once the criterion matches the value given by the user, the macro will copy the row.


I'm trying to create a macro, but there are some issues:
the following macro basically copies the entire row if the column B contains the value "1". But in my case, I would like to copy the entire row if a range of column (for ex: B via Z) contains the value "1". It would even be better, if the user could input a number/string and then if the column range from B via Z contains that specific string/number - it will automatically copy the entire row that contains that value in a new worksheet/xls file.

Sub SearchForNumber1()     

Dim LSearchRow As Integer     
Dim LCopyToRow As Integer     

On Error GoTo Err_Execute     

'Start search in row 1     
LSearchRow = 1     

'Start copying data to row 2 in Sheet2 (row counter variable)     
LCopyToRow = 2     

While Len(Range("A" & CStr(LSearchRow)).Value) > 0     

'If value in column E = "Mail Box", copy entire row to Sheet2     
If Range("B" & CStr(LSearchRow)).Value = "1" Then     

'Select row in Sheet1 to copy     
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select     

'Paste row into Sheet2 in next row     
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select     

'Move counter to next row     
LCopyToRow = LCopyToRow + 1     

'Go back to Sheet1 to continue searching     

End If     

LSearchRow = LSearchRow + 1     


'Position on cell A3     
Application.CutCopyMode = False     

MsgBox "All matching data has been copied."     

Exit Sub     

MsgBox "An error occurred."     

End Sub


Try this:

Sub customcopy()    
Dim strsearch As String, lastline As Integer, tocopy As Integer    

strsearch = CStr(InputBox("enter the string to search for"))    
lastline = Range("A65536").End(xlUp).Row    
j = 1    

For i = 1 To lastline    
    For Each c In Range("B" & i & ":Z" & i)    
        If InStr(c.Text, strsearch) Then    
            tocopy = 1    
        End If    
    Next c    
    If tocopy = 1 Then    
        Rows(i).Copy Destination:=Sheets(2).Rows(j)    
        j = j + 1    
    End If    
tocopy = 0    
Next i    

End Sub

Thanks to tompols for this tip.

Related :

This document entitled « Excel - Copy row if a range of column matches a value » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.