asked on

Find and then copy entire row to new sheet

Can an expert provide me with VBA code that will copy entire row[s] to a new sheet if any of the following is in column I

1-10 Days
10-20 Days
> 20 Days
0-1 Days
2-5 Days
>5 Days

I need to copy all rows that contain the above into sheet named Mena-Aged

Rgonzo1971

Hi,

pls try

Sub c2sheets()
astrConditions = "1-10 Days,10-20 Days,> 20 Days,0-1 Days,2-5 Days,>5 Days"

Set SrcSheet = ActiveSheet
Set DestSheet = Sheets("Mena-Aged")
For Idx = 2 To Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row).Count + 1
    If InStr(1, astrConditions, SrcSheet.Range("I" & Idx).Value, 1) > 0 Then
        SrcSheet.Range(Idx & ":" & Idx).Copy DestSheet.Range("I" & Cells.Rows.Count).End(xlUp).Offset(1).EntireRow
    End If
Next
End Sub

Open in new window

Regards

FarWest

I think the code above can be problematic, because if word "Days" is the only word or "0 Days" and maybe other instances will consider match it better to change the flowing

astrConditions = "1-10 Days,10-20 Days,> 20 Days,0-1 Days,2-5 Days,>5 Days"

Open in new window

astrConditions = "|1-10 Days|10-20 Days|> 20 Days|0-1 Days|2-5 Days|>5 Days|"

Open in new window

and this line

    If InStr(1, astrConditions, SrcSheet.Range("I" & Idx).Value, 1) > 0 Then

Open in new window

    If InStr(1, astrConditions, "|"+SrcSheet.Range("I" & Idx).Value+"|", 1) > 0 Then

Open in new window

Jagwarman

ASKER

Hi Rgonzo,

I am getting Variables not defined, can you help please

FarWest

Remove "option explicit" from top of coding Windows

Rgonzo1971

Hi,

pls try (Edited code)

Sub c2sheets()
Dim strConditions As String
Dim SrcSheet As Worksheets
Dim DestSheet As Worksheets
Dim Idx As Long

strConditions = "1-10 Days,10-20 Days,> 20 Days,0-1 Days,2-5 Days,>5 Days"

Set SrcSheet = ActiveSheet
Set DestSheet = Sheets("Mena-Aged")
For Idx = 2 To Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row).Count + 1
    If InStr(1, strConditions, SrcSheet.Range("I" & Idx).Value, 1) > 0 Then
        SrcSheet.Range("A" & Idx).EntireRow.Copy DestSheet.Range("I" & Cells.Rows.Count).End(xlUp).Offset(1).EntireRow
    End If
Next
End Sub

Open in new window

Jagwarman

ASKER

Hi Rgonzo I get Type mismatch at

Set SrcSheet = ActiveSheet

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jagwarman

ASKER

so simple when you know how... I just wish I did. Thanks