Macro to delete with filters
 

I am VERY new to macros...In fact, this is only my second macro. I have a
macro that i pieced together that will delete any line that has a "$0.00" in
column AP or a "NoCH" or "PrOK" in column O...however, i can't get it to
work...i've pasted it below...can you please tell me where i've gone wrong?
I get the "Debug" message...


Sub Filter_to_zero()
'
' Filter_to_zero Macro
' Macro recorded 1/10/2008 by Justin Christensen (ZJC0329 - CFS-L3E9621)
'

Selection.AutoFilter Field:=42, Criteria1:="$0.00 "
Rows("12:3500").Select
Range("AP12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("AP12").Select

Selection.AutoFilter Field:=15, Criteria1:="PrOK"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("O12").Select

Selection.AutoFilter Field:=15, Criteria1:="NoCh"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("A12").Select
End Sub

Thanks!!
~JC

Macro to delete with filters
 

Hi,

I may have missed something but I don't understand why you are filtering.
Maybe this alternative approach. Right click the sheet tab, view code and
paste this in. Try it on a copy of yopur worksheet first because delete in a
macro is pretty final, there's no UNDO.

Sub Filter_to_zero()
Dim MyRange, Bigrange As Range
lastrow = Range("AP65536").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("AP1:AP" & lastrow)
For Each c In MyRange
If c.Value = "$0.00" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
lastrow = Range("O65536").End(xlUp).Row
Set MyRange = Range("O1:O" & lastrow)
For Each c In MyRange
If c.Value = "NoCH" Or c.Value = "PrOK" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
If Not Bigrange Is Nothing Then
Bigrange.Delete
End If
End Sub

Mike


"JC" wrote:

I am VERY new to macros...In fact, this is only my second macro. I have a
macro that i pieced together that will delete any line that has a "$0.00" in
column AP or a "NoCH" or "PrOK" in column O...however, i can't get it to
work...i've pasted it below...can you please tell me where i've gone wrong?
I get the "Debug" message...


Sub Filter_to_zero()
'
' Filter_to_zero Macro
' Macro recorded 1/10/2008 by Justin Christensen (ZJC0329 - CFS-L3E9621)
'

Selection.AutoFilter Field:=42, Criteria1:="$0.00 "
Rows("12:3500").Select
Range("AP12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("AP12").Select

Selection.AutoFilter Field:=15, Criteria1:="PrOK"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("O12").Select

Selection.AutoFilter Field:=15, Criteria1:="NoCh"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("A12").Select
End Sub

Thanks!!
~JC

Macro to delete with filters
 

Mike,
Thanks for the response!! This is a template that my co-workers paste a
report into daily and then run my macro. I have filters already on my file as
my co-workers will filter to things after my macro runs...this macro gets rid
of all the stuff we don't need. Not sure if that'll change your response or
not...

Thanks for your help!!
~JC

"Mike H" wrote:

Hi,

I may have missed something but I don't understand why you are filtering.
Maybe this alternative approach. Right click the sheet tab, view code and
paste this in. Try it on a copy of yopur worksheet first because delete in a
macro is pretty final, there's no UNDO.

Sub Filter_to_zero()
Dim MyRange, Bigrange As Range
lastrow = Range("AP65536").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("AP1:AP" & lastrow)
For Each c In MyRange
If c.Value = "$0.00" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
lastrow = Range("O65536").End(xlUp).Row
Set MyRange = Range("O1:O" & lastrow)
For Each c In MyRange
If c.Value = "NoCH" Or c.Value = "PrOK" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
If Not Bigrange Is Nothing Then
Bigrange.Delete
End If
End Sub

Mike


"JC" wrote:

I am VERY new to macros...In fact, this is only my second macro. I have a
macro that i pieced together that will delete any line that has a "$0.00" in
column AP or a "NoCH" or "PrOK" in column O...however, i can't get it to
work...i've pasted it below...can you please tell me where i've gone wrong?
I get the "Debug" message...


Sub Filter_to_zero()
'
' Filter_to_zero Macro
' Macro recorded 1/10/2008 by Justin Christensen (ZJC0329 - CFS-L3E9621)
'

Selection.AutoFilter Field:=42, Criteria1:="$0.00 "
Rows("12:3500").Select
Range("AP12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("AP12").Select

Selection.AutoFilter Field:=15, Criteria1:="PrOK"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("O12").Select

Selection.AutoFilter Field:=15, Criteria1:="NoCh"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("A12").Select
End Sub

Thanks!!
~JC

Macro to delete with filters
 

Hi,

Not at all. I would simply ensure no filters are set and try the code I gave
you.

Mike

"JC" wrote:

Mike,
Thanks for the response!! This is a template that my co-workers paste a
report into daily and then run my macro. I have filters already on my file as
my co-workers will filter to things after my macro runs...this macro gets rid
of all the stuff we don't need. Not sure if that'll change your response or
not...

Thanks for your help!!
~JC

"Mike H" wrote:

Hi,

I may have missed something but I don't understand why you are filtering.
Maybe this alternative approach. Right click the sheet tab, view code and
paste this in. Try it on a copy of yopur worksheet first because delete in a
macro is pretty final, there's no UNDO.

Sub Filter_to_zero()
Dim MyRange, Bigrange As Range
lastrow = Range("AP65536").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("AP1:AP" & lastrow)
For Each c In MyRange
If c.Value = "$0.00" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
lastrow = Range("O65536").End(xlUp).Row
Set MyRange = Range("O1:O" & lastrow)
For Each c In MyRange
If c.Value = "NoCH" Or c.Value = "PrOK" Then
If Bigrange Is Nothing Then
Set Bigrange = c.EntireRow
Else
Set Bigrange = Union(Bigrange, c.EntireRow)
End If
End If
Next
If Not Bigrange Is Nothing Then
Bigrange.Delete
End If
End Sub

Mike


"JC" wrote:

I am VERY new to macros...In fact, this is only my second macro. I have a
macro that i pieced together that will delete any line that has a "$0.00" in
column AP or a "NoCH" or "PrOK" in column O...however, i can't get it to
work...i've pasted it below...can you please tell me where i've gone wrong?
I get the "Debug" message...


Sub Filter_to_zero()
'
' Filter_to_zero Macro
' Macro recorded 1/10/2008 by Justin Christensen (ZJC0329 - CFS-L3E9621)
'

Selection.AutoFilter Field:=42, Criteria1:="$0.00 "
Rows("12:3500").Select
Range("AP12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("AP12").Select

Selection.AutoFilter Field:=15, Criteria1:="PrOK"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("O12").Select

Selection.AutoFilter Field:=15, Criteria1:="NoCh"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("A12").Select
End Sub

Thanks!!
~JC

Macro to delete with filters
 

I didn't look at your code too closely...

But you're essentially doing the same thing three times--filtering, deleting,
filtering, deleting, filtering, deleting.

You could create an array that defines what you need to look in (what fields)
and another array to tell what to look for (what criteria).

If you want to try:

Option Explicit
Sub Filter_to_zero()

Dim wks As Worksheet
Dim myFields As Variant
Dim myCriteria As Variant
Dim iCtr As Long

myFields = Array(42, 15, 15)
myCriteria = Array("$0.00", "PrOk", "NoCh")

If UBound(myFields) < UBound(myCriteria) Then
'you should catch this error in testing
MsgBox "Design error!!!"
Exit Sub
End If

Set wks = ActiveSheet

With wks
If .AutoFilterMode = False Then
MsgBox "Please apply the filter!"
Exit Sub
End If

If .AutoFilter.Range.Columns.Count < Application.Max(myFields) Then
MsgBox "Not enough columns filtered!"
Exit Sub
End If

For iCtr = LBound(myFields) To UBound(myFields)
'remove any filter criteria--just in case.
If .FilterMode Then
.ShowAllData
End If

With .AutoFilter.Range
.AutoFilter Field:=myFields(iCtr), Criteria1:=myCriteria(iCtr)
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count 1 Then

.Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible) _
.EntireRow.Delete
End If
End With
Next iCtr
'show all the data after the last filter
'the "if" isn't necessary, but it won't hurt.
If .FilterMode Then
.ShowAllData
End If
End With
End Sub

This is the part that does the real work.

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count 1 Then

.Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible) _
.EntireRow.Delete
End If

It's checking to see if the number of visible cells in the first column (after
the filter has been applied) is more than 1 (the header is always visible).

If the number of visible cells is more than one, then it resizes the autofilter
range to one less (subtracting the header row) and offsets it by one row
(avoiding the header), and then deletes the entire row.



JC wrote:

I am VERY new to macros...In fact, this is only my second macro. I have a
macro that i pieced together that will delete any line that has a "$0.00" in
column AP or a "NoCH" or "PrOK" in column O...however, i can't get it to
work...i've pasted it below...can you please tell me where i've gone wrong?
I get the "Debug" message...

Sub Filter_to_zero()
'
' Filter_to_zero Macro
' Macro recorded 1/10/2008 by Justin Christensen (ZJC0329 - CFS-L3E9621)
'

Selection.AutoFilter Field:=42, Criteria1:="$0.00 "
Rows("12:3500").Select
Range("AP12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("AP12").Select

Selection.AutoFilter Field:=15, Criteria1:="PrOK"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("O12").Select

Selection.AutoFilter Field:=15, Criteria1:="NoCh"
Rows("12:1500").Select
Range("O12").Activate
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
Range("A12").Select
End Sub

Thanks!!
~JC

--

Dave Peterson