Deleting rows from table; Delete method of range class failed VBA

[andydtaylor]

Hi,

Would someone be willing to eyeball my code below and advise why it is failing at the line:

".Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete"?

What I find confusing is:

1. There is no sheet protection
2. The table headers are not selected
3. Changing the "Delete" method to "Select" works without issue.

I must apologise because I am somewhat out of practice with VBA as the Power Query/Pivot tools mitigate its need. Ironically this code is to work around a bug I have found with Power Query in the ancient 32 bit excel 2010 / 4-year old Power Query add-in I am having to use!

Thanks,

Andrew

Sub trial_code()

Dim BU_Selction As Variant
Dim Target_BU As String
Dim target_range As Range
Dim source_tables() As Variant
Dim source_table_BU_Pos() As Variant
Dim xlCalc As XlCalculation
Dim lCol As Long

'Record selected BU
BU_Selction = Worksheets("Config_BU").ListObjects("i_selected_BU").DataBodyRange.Value
Target_BU = BU_Selction(1, 1)

' Define table names and columns containing BU description for each table to be trimmed
source_tables = Array("o_Final", "Final_Output")
source_table_BU_Pos = Array(97, 71)


'Store current Calculation then switch to manual.
'Turn off events and screen updating
With Application
    xlCalc = .Calculation
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With



For n = 1 To 1

Set target_range = ActiveSheet.ListObjects(source_tables(n)).Range
lCol = source_table_BU_Pos(n)

With target_range
    .AutoFilter Field:=lCol, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>" & Target_BU
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With


Next n

'Turn calcs etc back on
With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   On Error GoTo 0


End Sub

 

[Yongle]

SpecialCells fails if there are no visible cells - use On Error Resume Next to allow the code to continue
Did you perhaps forget to include it or accidentally remove it - its normal partner On Error GoTo 0 is included in your code

With target_range
    .AutoFilter Field:=lCol, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>" & Target_BU
    [COLOR=#006400]On Error Resume Next[/COLOR]
    Debug.Print 1, .Address(0, 0)
    Debug.Print 2, .Offset(1, 0).Address(0, 0)
    Debug.Print 3, .SpecialCells(xlCellTypeVisible).Address(0, 0)
    Debug.Print 4, .Offset(1, 0).SpecialCells(xlCellTypeVisible).Address(0, 0)
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

End With

The code should no longer stop
- Debug.Print lines may help show you what the problem is
- see results printed to immediate window
- {CTRL} G is the toggle for Immediate Window (when in VBA)

 

[Akuini]

Use ".Delete" instead of "EntireRow.Delete"
Here's an example:

With ActiveSheet.ListObjects("Table1")
    .Range.AutoFilter Field:=1, Criteria1:="A"
    .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
End With

 

[Yongle]

@Akuini - that also fails if there are no records value "A" in first column

Sub test()
    With ActiveSheet.ListObjects(1)
        .Range.AutoFilter Field:=1, Criteria1:="A"
[COLOR=#ff0000]        On Error Resume Next[/COLOR]
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
        On Error GoTo 0
    End With
End Sub

 

[andydtaylor]

Thanks chaps - I went with this:

I actually have blanks I want to keep. Which I believe mitigates the filter failing, but resume next is the right idea.

The context is I am cleaning up some account data with the goal to enrich it further following manual input. Where my analysis suggests user account belongs to a BU I want the BU to confirm. Where I have not been able to map an account to any BU I want to flag this to all BUs so they have the opportunity to say they own the user. I am cutting up my master file for each BU hence deleting the data which does not relate to that BU, otherwise they will get confused (despite being grown human beings).

For n = 1 To 2

Application.Goto source_tables(n)
lCol = source_table_BU_Pos(n)

With ActiveSheet.ListObjects(source_tables(n))
    .Range.AutoFilter Field:=lCol, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>" & Target_BU
    On Error Resume Next
    .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    On Error GoTo 0
    .AutoFilter.ShowAllData
End With

Next n