VBA filter issue

[Bengo]

Hi,

I am trying to select and copy all rows on a worksheet (named Model) who's cell value in column "I" is greater than 0.00, and copy to a second worksheet called "Export"

This is how far I have got. I'm aware I think I currently have the filter criteria set to "=0", but using "<>" does not seem to work...

And when I currently run this, nothing gets copied onto the destination sheet even though all formulae in column I currently sum to 0...

Can anyone point me in the right direction please? Many thanks

-----------------------------------------------------------------------

Sub Extract()

Dim wsTO As Worksheet
Set wsTO = Sheets("Export")

With Worksheets("Model")
With .Range("I10:I" & .Cells(.Rows.Count, "I").End(xlUp).Row)
.AutoFilter field:=1, Criteria1:="0"

If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=wsTO.Range("A1")
End With
.AutoFilterMode = False
End With


End Sub

 

[Bengo]

Seen that .AutoFilter field:=1 should be ...:=9 for column I...

 

[billandrew]

Hope this points you in the right direction.

If you wish to copy all rows you should specify the correct Range, if you data is in A:I this should work.

Unsure what you are trying to do with the SubTotal Portion?

Sub FilterCopyNotZero()Dim wsTo As Worksheet
Set wsTo = Sheets("Export")
If AutoFilterMode Then AutoFilterMode = False


With Worksheets("Model").Range("A10", Range("I" & Rows.Count).End(xlUp))
.AutoFilter field:=9, Criteria1:="<>0"


.SpecialCells(xlCellTypeVisible).Copy Destination:=wsTo.Range("A1")
End With


Sheets("Model").AutoFilterMode = False
End Sub

The below will copy the Data without the Header if desired.

Sub FilterCopyNotZero()[COLOR=#0000ff]'Without Header Row[/COLOR]
Dim wsTo As Worksheet
Set wsTo = Sheets("Export")
If AutoFilterMode Then AutoFilterMode = False


With Worksheets("Model").Range("A10", Range("I" & Rows.Count).End(xlUp))
.AutoFilter field:=9, Criteria1:="<>0"


If .SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
.Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wsTo.Range("A1")
End If
End With


Sheets("Model").AutoFilterMode = False
End Sub

 

[Bengo]

Hope this points you in the right direction.

If you wish to copy all rows you should specify the correct Range, if you data is in A:I this should work.

Unsure what you are trying to do with the SubTotal Portion?

Sub FilterCopyNotZero()Dim wsTo As Worksheet
Set wsTo = Sheets("Export")
If AutoFilterMode Then AutoFilterMode = False


With Worksheets("Model").Range("A10", Range("I" & Rows.Count).End(xlUp))
.AutoFilter field:=9, Criteria1:="<>0"




.SpecialCells(xlCellTypeVisible).Copy Destination:=wsTo.Range("A1")
End With


Sheets("Model").AutoFilterMode = False
End Sub

The below will copy the Data without the Header if desired.

Sub FilterCopyNotZero()[COLOR=#0000ff]'Without Header Row[/COLOR]
Dim wsTo As Worksheet
Set wsTo = Sheets("Export")
If AutoFilterMode Then AutoFilterMode = False


With Worksheets("Model").Range("A10", Range("I" & Rows.Count).End(xlUp))
.AutoFilter field:=9, Criteria1:="<>0"


If .SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
.Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wsTo.Range("A1")
End If
End With


Sheets("Model").AutoFilterMode = False
End Sub

Thanks Billandrew! With a little tweaking for my sheet that has worked a treat! You were right about the subtotal, wasn't needed. Many thanks for your help much appreciated!

 

[billandrew]

Glad to help.