Special Cells - Delete Visible Rows using VBA code. Run time Error 1004

[johnny_raman]

Hi,

Thanks for your time.

I am trying to run the below macro code and have no issues till the last line (Macro 2) where all i want is to delete visible rows (special cells).

The last step either runs for 10-15 mins to complete the action or throws out at error (Runtime error 1004).

Also if by any chance can i change the Range from 20000 to selection until last cell pasted in the workbook.

Thanks in advance.

Sub Macro2()
    Dim lRow As Long
    Range("A1:XFD20000").Select
    Selection.AutoFilter
    Range("O1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=15, Criteria1:="B737"
    Selection.End(xlToRight).Select
    Range("AD1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=30, Criteria1:="<>"
    With ActiveSheet
        lRow = .Cells(.Rows.Count, 15).End(xlUp).Row
        If lRow = 1 Then Exit Sub
        .Cells(1, 15).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Value = "B737 BBJ"
    End With
    Range("A1:XFD20000").Select
    Selection.AutoFilter
    Range("O1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=15, Criteria1:="Non Aircraft Specific"
    Selection.End(xlToRight).Select
    Range("B1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=2, Criteria1:=Array("Amsterdam", "Dubai", "Shanghai", "UK Burgess Hill"), Operator:=xlFilterValues
    Selection.End(xlToRight).Select
    With ActiveSheet
        lRow = .Cells(.Rows.Count, 15).End(xlUp).Row
        If lRow = 1 Then Exit Sub
        .Cells(1, 15).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Value = "Others"
    End With
    Range("A1:XFD20000").Select
    Selection.AutoFilter
    Range("B1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=2, Criteria1:=Array("Dallas", "Bombardier - Montreal", "NETC", "BBD Dallas", "Embraer CAE Brazil", "Embraer CAE Dallas"), Operator:=xlFilterValues
    Selection.End(xlToRight).Select
    Range("AE1").Select
    ActiveSheet.Range("$1:$20000").AutoFilter Field:=31, Criteria1:=""
    ActiveSheet.Range("$1:$20000" & Lines).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End Sub

 

[Fluff]

Try

Sub Macro2()
    With ActiveSheet.UsedRange
      .AutoFilter 15, "B737"
      .AutoFilter 30, "<>"
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Columns(15).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value = "B737 BBJ"
      End If
      .Parent.AutoFilterMode = False
      .AutoFilter 15, "Non Aircraft Specific"
      .AutoFilter 2, Array("Amsterdam", "Dubai", "Shanghai", "UK Burgess Hill"), xlFilterValues
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Columns(15).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value = "Others"
      End If
      .Parent.AutoFilterMode = False
      .AutoFilter 2, Array("Dallas", "Bombardier - Montreal", "NETC", "BBD Dallas", "Embraer CAE Brazil", "Embraer CAE Dallas"), xlFilterValues
      .AutoFilter 31, ""
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).EntireRow.Delete
      End If
      .Parent.AutoFilterMode = False
   End With
End Sub

 

[johnny_raman]

Hi,

Thank you..! Regret the code still throws the same error and takes around 5 mins to " Excel cannot complete task with available resources. Choose less data or close other applications. [h=1][/h]

 

[Fluff]

How many rows & columns of data are you trying to delete?

 

[johnny_raman]

Selection/Range is 20,000 rows as the data varies. Visible cells for deletion after autofilter are around 9000 rows.

 

[Fluff]

Add these lines

Sub Macro2()
   [COLOR=#0000ff]With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With[/COLOR]
    With ActiveSheet.UsedRange
      .AutoFilter 15, "B737"
      .AutoFilter 30, "<>"
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Columns(15).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value = "B737 BBJ"
      End If
      .Parent.AutoFilterMode = False
      .AutoFilter 15, "Non Aircraft Specific"
      .AutoFilter 2, Array("Amsterdam", "Dubai", "Shanghai", "UK Burgess Hill"), xlFilterValues
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Columns(15).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value = "Others"
      End If
      .Parent.AutoFilterMode = False
      .AutoFilter 2, Array("Dallas", "Bombardier - Montreal", "NETC", "BBD Dallas", "Embraer CAE Brazil", "Embraer CAE Dallas"), xlFilterValues
      .AutoFilter 31, ""
      If .Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
         .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).EntireRow.Delete
      End If
      .Parent.AutoFilterMode = False
   End With
   [COLOR=#0000ff]With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
   End With[/COLOR]
End Sub

Does it make any difference?

 

[johnny_raman]

Amazing to see how my work load has been minimized. Macro just works fine.

Thank you so much.. appreciate your help !!

 

[Fluff]

Glad to help & thanks for the feedback