I am yet again faced with this error 1004; I was given some very good answers here, that I now am trying to apply to a bigger and more "complex" sub.
I first get my Agence name from my macro-wielding workbook owb. I then open both files I need to use afetrwards. I cycle through the first one using a range RngDate, use the Union method to gather all CellDates from before 1st of July 2021 in my range Poubelle (trash). Once I'm out of the RngFact loop, I simply use the .Delete method and it works just fine.
I later on cycle through all my clients using another range (RngClient), and for each of them I cycle once again through all my bills (factures in french) in the range RngFact to find theirs, and after getting the information I need I add the bill I just studied to the Poubelle/trash. But when I try to use .Delete once I'm out of the loop using the range/cells/worksheet I want to delete, it brings back error 1004. I isolated the line triggering the RTE1004 in the code. Even though I am now "only" in a loop using my agency's sheet (wba) itself in a loop using my macro's sheet (owb), both unaffected by the .Delete operation.
edit: I am doing so because I have to go through dozens of thoushands of lines each time, so if each iteration can remove a few lines each time it helps a lot. (end of edit)
I wracked my brain but I do not comprehend what's the difference between the case that works and the one that doesn't. Please help me! (again ;-;)
(I do realize using this many loops is probably inefficient but heh it worked so far)
Sub GrosTas()
Const FolderPath As String = "C:\Users\QNS691\Documents\Excel\par agence 3\"
Dim y As Integer: y = 0
Dim owb As Workbook: Set owb = ThisWorkbook
Dim ows As Worksheet: Set ows = owb.Worksheets("Feuil1")
Dim PremAg As Range: Set PremAg = ows.Range("X2")
Dim LastAg As Range: Set LastAg = ows.Range("X" & ows.Cells(Rows.Count, "X").End(xlUp).Row)
Dim RngAg As Range: Set RngAg = ows.Range(PremAg, LastAg)
Dim CellClient As Range
Dim CellDate As Range
Dim CellFact As Range
Dim Agence As String
Dim FilePath As String
Dim wba As Workbook
Dim wsa As Worksheet
Dim RngClient As Range
Dim RngDate As Range
Dim RngFact As Range
Dim Poubelle As Range
Dim ID As Integer
Dim M_H As Integer
Dim N_H As Integer
Dim M_E As Integer
Dim N_E As Integer
Dim prevdate As String
Dim mois As Integer
Dim Ligne As Integer
For Each CellAg In RngAg
Agence = CStr(CellAg.Value)
If Len(Agence) > 0 Then
FilePathAg = FolderPath & Agence & ".xlsx"
FilePathFact = FolderPath & "\fact\F_" & Agence & ".xlsx"
If Len(Dir(FilePathAg)) > 0 And Len(Dir(FilePathFact)) > 0 Then
Set wba = Workbooks.Open(FilePathAg)
Set wsa = wba.Worksheets(1)
Set wbf = Workbooks.Open(FilePathFact)
Set wsf = wbf.Worksheets(1)
Set RngClient = wsa.Range("B2", wsa.Cells(wsa.Cells(wsa.Rows.Count, "B").End(xlUp).Row, "B"))
Set RngDate = wsf.Range("M2", wsf.Cells(wsf.Cells(wsf.Rows.Count, "M").End(xlUp).Row, "M"))
For Each CellDate In RngDate
If IsDate(CellDate) Then
If CellDate.Value < CDate("01/07/2021") Then
y = y + 1
If Poubelle Is Nothing Then
Set Poubelle = CellDate
Else
Set Poubelle = Union(Poubelle, CellDate)
End If
End If
End If
Next CellDate
If Not Poubelle Is Nothing Then
Poubelle.EntireRow.Delete ' THIS ONE WORKS JUST FINE
End If
Set Poubelle = Nothing
With wsa
.Range("Tableau1").Columns(14).Clear
.Range("Tableau1").Columns(13).Clear
.Range("Tableau1").Columns(12).Clear
.Range("Tableau1").Columns(11).Clear
.Range("Tableau1").Columns(10).Clear
.Range("Tableau1").Columns(9).Clear
End With
For Each CellClient In RngClient
ID = CellClient.Value
M_H = 0
N_H = 0
M_E = 0
N_E = 0
prevdate = ""
Set RngFact = wsf.Range("K2", wsf.Cells(wsf.Cells(wsf.Rows.Count, "K").End(xlUp).Row, "K"))
For Each CellFact In RngFact
If CellClient = CellFact Then
mois = Month(wsf.Range("M" & CellFact.Row))
If mois >= 3 And mois <= 8 Then
If Not wsf.Range("M" & CellFact.Row) = prevdate Then
prevdate = wsf.Range("M" & CellFact.Row)
N_E = N_E + 1
End If
M_E = M_E + wsf.Range("T" & CellFact.Row)
Else
If Not wsf.Range("M" & CellFact.Row) = prevdate Then
prevdate = wsf.Range("M" & CellFact.Row)
N_H = N_H + 1
End If
M_H = M_H + wsf.Range("T" & CellFact.Row)
End If
If Poubelle Is Nothing Then
Set Poubelle = CellFact
Else
Set Poubelle = Union(Poubelle, CellFact)
End If
End If
Next CellFact
If Not Poubelle Is Nothing Then
Poubelle.EntireRow.Delete 'THIS ONE IS RESISTING DELETION
End If
Set Poubelle = Nothing
With wsa
.Cells(CellClient, 9) = M_E
.Cells(CellClient, 10) = N_E
.Cells(CellClient, 11) = M_H
.Cells(CellClient, 12) = N_H
.Cells(CellClient, 13) = M_E + M_H
.Cells(CellClient, 14) = N_E + N_H
End With
Next CellClient
End If
End If
With wsa
Ligne = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("I" & Ligne).Select ' = "=SOUS.TOTAL(109;[Marge Ete])"
.Range("I" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(9))
.Range("J" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(10))
.Range("K" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(11))
.Range("L" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(12))
.Range("M" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(13))
.Range("N" & Ligne) = Application.WorksheetFunction.Subtotal(109, .Range("Tableau1").Columns(14))
End With
wba.Close SaveChanges:=True
wbf.Close SaveChanges:=True
Next CellAg
MsgBox y
End Sub
