Copy row to another sheet if cell contains a 0

[aiwnjoo]

Is there an easy way to automate if a cell in Column O for example contains a 0 then it highlights the entire row and pastes it into the next available row in another sheet lets call this Zeros.
Ive tried using the recorder but it gets funky.

Thanks,

 

[Jon von der Heyden]

Hi

Try using the autofilter method, something like:

[COLOR=blue]Public[/COLOR] [COLOR=blue]Sub[/COLOR] CopyZeros()
    [COLOR=blue]With[/COLOR] ActiveSheet
        .AutoFilterMode = [COLOR=blue]False[/COLOR]
        [COLOR=blue]With[/COLOR] Intersect(.Columns("O"), .UsedRange)
            .AutoFilter Field:=1, Criteria1:="=0"
            .Offset(1).SpecialCells(12).EntireRow.Copy _
                Destination = Sheets("Zeros").Range("A" & Rows.Count).End(xlUp)(2)
            .AutoFilter
        [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

 

[aiwnjoo]

No that does not work;

I presume this goes into a New Module?

It should work on the fly as i work,

As soon as i type 0 in it will initiate the macro to copy that row into the last available row in Zeros, when using the AutoFilter it will find every result of 0 in Column O which is not what i want and it will also interefere with other macros and hidden/filtered cells.

I know you can also set Intersect to only start counting the macro from a certain row which would be Row 1000 in our case, so any 0's type into Column O will then start the procedure.

Thanks,

 

[Jon von der Heyden]

It sounds like you need a sheet change event, something like this:

In the appropriate sheet module:

[COLOR="Blue"]Private[/COLOR] [COLOR="Blue"]Sub[/COLOR] Worksheet_Change([COLOR="Blue"]ByVal[/COLOR] Target [COLOR="Blue"]As[/COLOR] Range)
    [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]Not[/COLOR] Intersect(Target, Columns("O")) [COLOR="Blue"]Is[/COLOR] [COLOR="Blue"]Nothing[/COLOR] [COLOR="Blue"]Then[/COLOR]
        Target.EntireRow.Copy Destination:=Sheets("Zeros").Range("A" & Rows.Count).End(xlUp)(2)
        Application.CutCopyMode = [COLOR="Blue"]False[/COLOR]
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

I hope column O is the last column because as soon as it has been entered it will copy to the other sheet.

 

[aiwnjoo]

Column O is not the last column but if its copying the entire row that will be fine. Ill test it out and let you know,

Thanks,

 

[aiwnjoo]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("O")) Is Nothing Then
        Target.EntireRow.Copy Destination:=Sheets("Zeros").Range("A" & Rows.Count).End(xlUp)(2)
        Application.CutCopyMode = False
    End If
End Sub

This works however when i goto the next row down and enter another 0 it only paste to the same row as the last one where it should paste in the next row down.

Also it copy pastes the full row however i could do with it just copy pasting A:V and just Values instead of Formats aswell.

Thanks,

 

[aiwnjoo]

bump, thx

 

[aiwnjoo]

bump, sorry.

 

[Jon von der Heyden]

try;

[COLOR="Blue"]Private[/COLOR] [COLOR="Blue"]Sub[/COLOR] Worksheet_Change([COLOR="Blue"]ByVal[/COLOR] Target [COLOR="Blue"]As[/COLOR] Range)
    [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]Not[/COLOR] Intersect(Target, Columns("O")) [COLOR="Blue"]Is[/COLOR] [COLOR="Blue"]Nothing[/COLOR] [COLOR="Blue"]Then[/COLOR]
        [COLOR="Blue"]If[/COLOR] Target.Value = 0 [COLOR="Blue"]Then[/COLOR]
            Intersect(Target.EntireRow, Columns("A:V")).Copy
            Sheets("Zeros").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
            Application.CutCopyMode = [COLOR="Blue"]False[/COLOR]
        [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

 

[aiwnjoo]

This works fine it seems but when i enter another 0 on the next cell down in the sheet where this is placed it pastes it into the same line the last 0 just pasted to where as it should paste on the next line down.

Thanks,