copy rows containing given values

[j.farr3ll]

I have a workbook with data in columns A:HN.

What I'm trying to do is copy any rows where the range O:HN contains a 3, 4, 5, 6 or 7 to a new sheet.

I have been using the following code:

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("o" & i & ":HN" & i)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
        Rows(i).Copy Destination:=Sheets(4).Rows(j)
        j = j + 1
    End If
tocopy = 0
Next i

End Sub

and running it 5 times (with 3 as string, then 4, then 5 etc...)

However, I'm getting duplicates. I imagine where rows contain for example a 5 and 6? Is there a more accurate way to do this?

[JOHN H. DAVIS]

Maybe:

Sub j_farr3llyy()
Dim strsearch As String, lastline As Long, 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("o" & i & ":HN" & i)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
        Rows(i).Copy Destination:=Sheets(4).Rows(J)
        J = J + 1
        GoTo zz
    End If
zz:
tocopy = 0
Next i

End Sub

Or?

Sub j_farr3ll()
Dim i As Long
Dim x As Long
Dim c As Range
Dim lastline As Long
lastline = Range("A65536").End(xlUp).Row
    For i = 1 To lastline
        For x = 3 To 7
            For Each c In Range("o" & i & ":HN" & i)
                If c.Value Like "*" & x & "*" Then
                    Rows(i).Copy Sheets("Sheet4").Range("A" & Rows.count).End(3)(2)
                    GoTo zz
                End If
            Next c
        Next x
zz:
    Next i

End Sub

[j.farr3ll]

I have used the second code and it seems to work great. Many Thanks, James

[JOHN H. DAVIS]

You're welcome. Glad to help out and thanks for the feedback.