Filter, Delete and Error handling - need help

E

esmagol

Hi everyone,

I am doing various filter and delete routine in one of my worksheet to
finish my report. I am planning to successively run those routines to
save time. My problem is when one of my filter and delete routine
cannot match its criteria vba will return Run-time error '1004'. I
want to have an error handling that will call the next routine should
vba encountered this error and if not that much a simple message box
that this particular routine resulted to an error and will ask if the
user want to continue running the macro or not. Below is one of my
basic filter and delete routine (got it here also :).

Have a nice day! Thanks everyone for your time :)

Sub tester2()

Dim rng As Range

Sheets("New").Select

Application.Goto Reference:=Range("A1:D1") 'Range for names

Selection.AutoFilter
Selection.AutoFilter Field:=2, _
Criteria1:=120 'creteria is filter range

'ActiveSheet.Range("$A$6:$AE$21893").AutoFilter Field:=15,
Criteria1:="=120" _
, Operator:=xlOr, Criteria2:="=420"

'use Operator:=xlor if more than one criteria

Set rng = ActiveSheet.AutoFilter.Range
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
Set rng = rng.Columns(1).SpecialCells(xlVisible).EntireRow
rng.Delete

ActiveSheet.AutoFilterMode = False 'deactivate filter

End Sub
 
P

Per Jessen

This should do it:

Sub tester3()
Dim FilterRng As Range
Dim rng As Range

Sheets("New").Select
Range("A1:D1").AutoFilter Field:=2, Criteria1:=120 'creteria is
filter range)

Set rng = ActiveSheet.AutoFilter.Range

If rng.SpecialCells(xlVisible).Rows.Count > 1 Then
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
Set rng = rng.Columns(1).SpecialCells(xlVisible).EntireRow
rng.Delete
End If

ActiveSheet.AutoFilterMode = False 'deactivate filter
End Sub

Regards,
Per
 
E

esmagol

This should do it:

Sub tester3()
Dim FilterRng As Range
Dim rng As Range

Sheets("New").Select
 Range("A1:D1").AutoFilter Field:=2, Criteria1:=120 'creteria is
filter range)

Set rng = ActiveSheet.AutoFilter.Range

If rng.SpecialCells(xlVisible).Rows.Count > 1 Then
    Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
    Set rng = rng.Columns(1).SpecialCells(xlVisible).EntireRow
    rng.Delete
End If

ActiveSheet.AutoFilterMode = False 'deactivate filter
End Sub

Regards,
Per













- Show quoted text -

Thanks Per for the reply. I'm still encountering the same error, hope
I can fix it. Thanks again.
 
P

Per Jessen

Which line is highlighted when the error occure (click Debug to see
the line causing the error).

If you prefer you can mail me a sample workbook where I can see what
is happening.

Per
 
P

Per Jessen

Hi Jerome

Based on the sample file you sent me, this is what you need.

Sub ReArrangeData()
Dim FilterRng As Range
Dim TargetRng As Range
Dim Field1Array()
Dim Field2 as string
Dim DestCell As Range
Dim sh As Worksheet

Application.ScreenUpdating = False

Set sh = Worksheets("Big Favor")

With sh
Set FilterRng = .Range("A3", .Range("A3").End(xlDown))
Set TargetRng = FilterRng.Offset(1, 1).Resize(FilterRng.Rows.Count
- 1, 1)
Set DestCell = Range("E4")
field2 = .Range("B4")
End With

FilterRng.AdvancedFilter Action:=xlFilterInPlace, unique:=True
ReDim
Field1Array(FilterRng.SpecialCells(xlCellTypeVisible).Cells.Count - 1)

For Each cell In FilterRng.SpecialCells(xlCellTypeVisible)
Field1Array(c) = cell
c = c + 1
Next
sh.ShowAllData

For c = 1 To UBound(Field1Array)
DestCell = Field1Array(c)
field2 = FilterRng.Find(what:=Field1Array(c),
after:=sh.Range("A3")).Offset(0, 1)
off = 0
FilterRng.AutoFilter field:=1, Criteria1:=DestCell
For Each cell In TargetRng.SpecialCells(xlCellTypeVisible)
If field2 = cell Then
off = off + 1
DestCell.Offset(0, 1) = cell
DestCell.Offset(0, off + 1) = cell.Offset(0, 1)
Else
off = 0
field2 = cell
Set DestCell = DestCell.Offset(1, 0)
DestCell = Field1Array(c)
DestCell.Offset(0, 1) = cell
off = off + 1
DestCell.Offset(0, off + 1) = cell.Offset(0, 1)
End If
Next
Set DestCell = DestCell.Offset(1)
FilterRng.AutoFilter
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top