Looking to copy entire row if a cell value is greater than zero

any ideas??


attached a sheet
If column D is greater than 0 then I want to copy the entire row to Sheet 2

basically, I only want to see rows with a quantity on Sheet 2

this is an ongoing, feed so I can't use Filter

THANKS!!!

Hello Dadof2,

This code may help:-

Sub CopyIt()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Sheet1").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("D2:D" & lRow)
    If cell <> 0 Then
       cell.EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
       
    End If
 Next cell
Sheets("Sheet2").Range("A1:K" & Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Sheet2").Columns.AutoFit
Sheets("Sheet2").Select
Application.ScreenUpdating = True

End Sub

Here is a sample work book:-

Let us know if it does the job for you.

Cheerio,
vcoolio.

Hi.

this is an ongoing, feed so I can't use Filter

Can you explain that.. it would be much fast to:

1. Autofilter your range by column D for values >0.

2. Copy the visible rows after autofilter to the other sheet. No loop needed..

Why can't you use autofilter?

Originally Posted by apo

Hi.



Can you explain that.. it would be much fast to:

1. Autofilter your range by column D for values >0.

2. Copy the visible rows after autofilter to the other sheet. No loop needed..

Why can't you use autofilter?

Doing this, do I have to manually click the auto-filter each time? Currently, I pull in the info using an API and would like this to automatically look for the bonds with greater than zero quantity and run. I am trying to do this with as little steps as possible. I will set this up and have some "older" users use it so it needs to be as dummy proof as possible. does that make sense???

THX
Mark

Okay, I ran it and have a question

The first time it runs it works, but if I run it again (say later in the day) I get the old info and and new bonds that meet the criteria. How do I get it to clear the Sheet2 and give me a fresh look every time??

Thanks
Mark

Thanks for the help!

Hi..

Try this..

Note: You will need to add column headers like i have in the attached Workbook..

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    With Range("A1").CurrentRegion
        Sheets("Sheet2").Range("A1").CurrentRegion.Offset(1).ClearContents
        .AutoFilter 4, ">0"
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
        .AutoFilter
    End With
    Application.ScreenUpdating = True
    Sheets("Sheet2").Select
End Sub