VBA/ Method Delete of Class Range failed-CodePudding

I am trying to delete a row if the value I check is 0. So far I did almost the exact same in another set of workbooks, and it went just fine. Both cases involve getting the agency's name from the startup workbook, then opening the first workbook of the set that needs deletion, looping through it and deleting what needs to be deleted, closing it and moving on to the next one (here I go from 2 to 2 because there's no need to go through all of them just yet)

I did my homework and looked it up beforehand. No, not my table nor my sheet nor my workbook nor any range is protected. Yes, I made sure to activate the workbook I want to affect, and it has only one sheet in it. Using .Select works, deleting manually isn't possible. It seems a cell is locked, but even unlocking it doesn't allow me to manually delete the row. here it's unlocked.

Edit - I tried running it with the original set of workbooks, and it worked just fine (the one I'm working with is a copy of the original)

Sub PetitTas()

deb = Now()
For i = 2 To 2
    Workbooks("dimensionnement technos 2").Activate
    Agence = Cells(i, 24)
    Workbooks.Open "C:\Users\QNS691\Documents\Excel\par agence 2\" & Agence & ".xlsx"
    Workbooks(Agence).Activate
    For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(j, 14) = 0 Then
            Rows(j).EntireRow.Delete
        End If
    Next j
    Workbooks(Agence).Close SaveChanges:=True
Next i
MsgBox deb & " " & Now()
End Sub

I am running out of ideas, please help!

CodePudding user response：

Overall you shouldn't be relying on the active sheet or the .Activate method. You should look at how-to-avoid-using-select-in-excel-vba

With that, explicitly use the Workbook and Worksheet when working with any Range or Cell.

Now your deletion is removing rows that your loop is depending on, so one fix is to loop backwards.

Below is my quick fixes to your code, but note it isn't tested.

Option Explicit

Public Sub PetitTas()
    Dim deb As Date ' Was missing
    deb = Now()
    
    Dim i As Long ' Was missing
    For i = 2 To 2
        
        ' Use the specific worksheet reference.
        ' Using activate isn't reliable and
        ' hurts performance
        Dim agence As Variant
        agence = Workbooks("dimensionnement technos 2") _
            .Worksheets(1) _
            .Cells(i, 24)
        
        ' Capture your workbook into a variable for the
        ' same reason above, activate is not your friend
        ' in most cases. Only time is when you need to display
        ' a user a specific sheet.
        Dim wb As Workbook
        Set wb = Workbooks.Open( _
            "C:\Users\QNS691\Documents\Excel\par agence 2\" & _
            agence & ".xlsx" _
        )
        
        
        ' Use a with statement to capture your
        ' worksheet, that way `.Cells` is pointing
        ' explicitly to the correct sheet.
        With wb.Worksheets(1)
            Dim j As Long ' Was missing
            
            ' When deleting in a loop, either capture
            ' all ranges into a variable a delete after loop
            ' or step backwards. I steped backwards for this demo
            ' for simplicity, but single deletion is more performant
            For j = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
                If .Cells(j, 14) = 0 Then
                    .Rows(j).EntireRow.Delete
                End If
            Next j
        End With
        
        wb.Close SaveChanges:=True

    Next i
    MsgBox deb & " " & Now()
End Sub

CodePudding user response：

Delete Entire Rows (`Union`)

Sub PetitTas()
    
    Const FolderPath As String = "C:\Users\QNS691\Documents\Excel\par agence 2\"

    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Worksheets("Feuil1")
    Dim sfCell As Range: Set sfCell = sws.Range("X2")
    Dim slCell As Range: Set slCell = sfCell.Resize( _
        sws.Rows.Count - sfCell.Row   1).Find("*", , xlFormulas, , , xlPrevious)
    Dim srg As Range: Set srg = sws.Range(sfCell, slCell)
    
    Application.ScreenUpdating = False
    
    Dim sCell As Range
    Dim Agency As String
    Dim FilePath As String
    Dim dwb As Workbook
    Dim dws As Worksheet
    Dim durg As Range
    Dim drg As Range
    Dim dCell As Range
    
    For Each sCell In srg.Cells
        Agency = CStr(sCell.Value)
        If Len(Agency) > 0 Then
            FilePath = FolderPath & Agency & ".xlsx"
            If Len(Dir(FilePath)) > 0 Then ' check if the file exists...
                Set dwb = Workbooks.Open(FilePath) ' ... only then open it
                Set dws = dwb.Worksheets(1) ' the one and only
                Set drg = dws.Range("N2", dws.Cells( _
                    dws.Cells(dws.Rows.Count, "A").End(xlUp).Row, "N"))
                For Each dCell In drg.Cells
                    If IsNumeric(dCell) Then
                        If dCell.Value = 0 Then
                            If durg Is Nothing Then
                                Set durg = dCell
                            Else
                                Set durg = Union(durg, dCell)
                            End If
                        End If
                    End If
                Next dCell
                If durg Is Nothing Then
                    dwb.Close SaveChanges:=False
                Else
                    durg.EntireRow.Delete
                    Set durg = Nothing
                    dwb.Close SaveChanges:=True
                End If
            End If
        End If
    Next sCell
    
    Application.ScreenUpdating = True
    
    MsgBox "'PetitTas' is done.", vbInformation
        
End Sub

Delete Entire Rows (Union)

Delete Entire Rows (`Union`)