PDA

View Full Version : Solved: test filter and delete row in OLD and NEW office



hardlife
09-08-2010, 04:21 AM
Please, does somebody can tell me, how to fix the code below,
to work correctly in both office (2000 / 2007) ?

When is used filtering in older office to delete specific rows,
filter also deletes row with "Total" which is not filtred,

if is not used OFFSET, probably new office do not work correctly,

does somebody know solution for both of office using AUTOFILTER?

INPUT DATA:

No. company Price
1 A 10
2 B 100
3 A 10
4 B 100
5 A 10
6 B 100
7 A 10
8 B 100
9 A 11
10 B 110
Total 561




Sub filter_and_export()

Application.DisplayAlerts = False

ActiveWorkbook.Sheets("A").Delete
ActiveWorkbook.Sheets("B").Delete

Sheets("DATA").Copy AFTER:=Sheets("DATA")
ActiveSheet.Name = "B"
Sheets("DATA").Select

Sheets("DATA").Copy AFTER:=Sheets("DATA")
ActiveSheet.Name = "A"
Sheets("DATA").Select

Sheets("A").Select
Set FilterRange = Range("B1:B11")
FilterRange.AutoFilter Field:=1, Criteria1:="B"
FilterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

Sheets("B").Select
Set FilterRange = Range("B1:B11")
FilterRange.AutoFilter Field:=1, Criteria1:="A"
FilterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

Application.DisplayAlerts = True

End Sub


me is wishing HAPPY AND SUNNY DAY to everybody :hi:

stanleydgrom
09-08-2010, 06:57 PM
hardlife,

Try including in your filtered range the total row.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).





Sub filter_and_export()

Application.DisplayAlerts = False

ActiveWorkbook.Sheets("A").Delete
ActiveWorkbook.Sheets("B").Delete

Sheets("DATA").Copy AFTER:=Sheets("DATA")
ActiveSheet.Name = "B"
Sheets("DATA").Select

Sheets("DATA").Copy AFTER:=Sheets("DATA")
ActiveSheet.Name = "A"
Sheets("DATA").Select

Sheets("A").Select
Set FilterRange = Range("B1:B12")
FilterRange.AutoFilter Field:=1, Criteria1:="B"
FilterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

Sheets("B").Select
Set FilterRange = Range("B1:B12")
FilterRange.AutoFilter Field:=1, Criteria1:="A"
FilterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False

Application.DisplayAlerts = True

End Sub

hardlife
09-09-2010, 08:41 AM
stanleydgrom,

many Thanks, for Your HELP and beautiful solution,

it is working now in both of office.

me is wishing You, Good luck and Beautiful days :hi: