maroine
maroine

Reputation: 33

"Object Required" Error with Collections

I have a problem with my VBA code, I try to eliminate the duplicates of a list of reimbursement while accumulating the values of columns B and C, but this is with conditions, i mean to eliminate a duplicate it is obligatory that the values of the columns A and H are identical to the values A and H of the duplicate line so it is necessary to have the two conditions to remove a duplicate, thank you for your help this is the code I have previously built but it gives me "object required" error

excel table of the vba code

Sub Bouton1_Cliquer()
Dim Cel As Range
Dim Cel1 As Range
Dim Plage As Range
Dim Plage1 As Range
Dim Col As New Collection
Dim col1 As New Collection
Dim Cumul As Double
Dim Cumul1 As Double
Dim DerLig As Long, i As Long, j As Long, MémoL As Long, p As Long
Dim PremL As Boolean
Dim CodeADELI As String

Application.ScreenUpdating = False
Set Col = New Collection
Set col1 = New Collection
On Error Resume Next



With Worksheets("Feuil1") 'Nom de feuille à adapter
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
    DerLig1 = .Range("H" & .Rows.Count).End(xlUp).Row
    'Les Codes ADELI sont placés dans une collection afin d'obtenir une liste sans doublon
    Set Plage = .Range("A2:A" & DerLig)
    Set Plage1 = .Range("H2:H" & DerLig1)

    For Each Cel In Plage
    If Cel <> "" Then Col.Add Cel, CStr(Cel)
    Next Cel

    For Each Cel1 In Plage1
    If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)
    Next Cel1

    On Error GoTo 0

    'On boucle sur chaque élément de la collection que l'on compare aux codes de la liste.
    For i = 1 To Col.Count
        For p = 1 To col1.Count

    Cumul1 = 0
    Cumul = 0 'Initialisation du total
    MémoL = 0
    PremL = True

        CodeADELI = Col(i)
        INSEE = col1(p)

        'chaque élément de la collection est comparé aux codes de la liste.
        For j = DerLig To 2 Step -1

            If .Range("A" & j).Value = CodeADELI And .Range("H" & j).Value = INSEE Then
                'On ajoute le montant au cumul
                    Cumul = Cumul + .Range("B" & j).Value
                    Cumul1 = Cumul1 + .Range("C" & j).Value
                    'S'il s'agit de la première ligne , on mémorise le numéro de ligne
                    If PremL Then
                        MémoL = j
                        PremL = False
                    'Sinon, on supprime la ligne (doublon)
                    Else
                        .Rows(j).Delete
                        MémoL = MémoL - 1
                        DerLig = DerLig - 1
                        DerLig1 = DerLig
                End If
            End If

        Next j

        'Le cumul est affecté au montant de la ligne  qui reste
        If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
        If MémoL > 0 Then .Range("B" & MémoL) = Cumul

         Next p
    Next i

    End With
    End Sub

Upvotes: 2

Views: 1762

Answers (2)

Variatus
Variatus

Reputation: 14383

Your use of Col is conceptually wrong.

Sub Bouton1_Cliquer()
    ' 28 Sep 2017

    Dim Rng As Range
    Dim Rl As Long

    With Worksheets("Feuil1")
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' columns 1 = A, 8 = H
        .Range(.Cells(2, "A"), .Cells(Rl, .UsedRange.Columns.Count)) _
               .RemoveDuplicates Columns:=Array(1, 8), Header:=xlNo
        Set Rng = .Range(.Cells(2, "B"), .Cells(Rl, "B"))

        Rl = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        .Cells(Rl, "B").Value = Application.Sum(Rng)
        Rl = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
        .Cells(Rl, "C").Value = Application.Sum(Rng.Offset(0, 1))
    End With
End Sub

As you see, with a different concept you need much less code. Or, in reverse order, the concept to which the use of Col led you required more effort than would otherwise have been needed.

Upvotes: -1

YowE3K
YowE3K

Reputation: 23974

Your problem can be fixed by changing the lines

If Cel <> "" Then Col.Add Cel, CStr(Cel)

and

If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)

to

If Cel <> "" Then Col.Add CStr(Cel), CStr(Cel)

and

If Cel1 <> "" Then col1.Add Cstr(Cel1), CStr(Cel1)

The error is caused by the fact that later in your code, where you are using col(i) and col1(p), the collection was referring to a range object which had been deleted by the line of code saying .Rows(j).Delete.

By changing the collection to be just the value of the cell, rather than the cell itself, it won't be destroyed by the deletion of the row.


A Dictionary, or simply a dynamically dimensioned String array, may be a better way of keeping track of which "keys" you wish to match on.

Sub Bouton1_Cliquer()
    Dim dict As Dictionary
    Dim key As Variant
    Dim Cumul As Double
    Dim Cumul1 As Double
    Dim DerLig As Long, i As Long, j As Long, MémoL As Long
    Dim PremL As Boolean

    Application.ScreenUpdating = False
    Set dict = New Dictionary

    With Worksheets("Feuil1") 'Nom de feuille à adapter
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To DerLig
            If Not dict.Exists(.Cells(i, "A") & "|" & .Cells(i, "H")) Then
                dict.Add .Cells(i, "A") & "|" & .Cells(i, "H"), .Cells(i, "A") & "|" & .Cells(i, "H")
            End If
        Next

        For Each key In dict.Keys

            Cumul1 = 0
            Cumul = 0 'Initialisation du total
            MémoL = 0
            PremL = True

            'chaque élément de la collection est comparé aux codes de la liste.
            For j = DerLig To 2 Step -1

                If key = .Cells(j, "A").Value & "|" & .Cells(j, "H").Value Then
                    'On ajoute le montant au cumul
                    Cumul = Cumul + .Range("B" & j).Value
                    Cumul1 = Cumul1 + .Range("C" & j).Value
                    'S'il s'agit de la première ligne , on mémorise le numéro de ligne
                    If PremL Then
                        MémoL = j
                        PremL = False
                    'Sinon, on supprime la ligne (doublon)
                    Else
                        .Rows(j).Delete
                        MémoL = MémoL - 1
                        DerLig = DerLig - 1
                    End If
                End If

            Next j

            'Le cumul est affecté au montant de la ligne  qui reste
            If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
            If MémoL > 0 Then .Range("B" & MémoL) = Cumul

        Next

    End With
End Sub

Note: I'm not sure whether any of your original code comments still make sense - I didn't try to translate them to see what they were saying.

Upvotes: 2

Related Questions