CODEWITHSUNDEEP
vbaexcel
Ross
Ross

Reputation: 61

Sum and Delete Duplicate Rows

I need a table that shows the DriverName and Duration columns, every other column can be deleted. All duplicates must be delete and the duration for each driver should be summed.

I've been struggling with this for a while, the code i've been trying to use is below. It needs to be done in Vba.

If anyone can help I would greatly appreciate it.

Sub MG02Sep59
Dim Rng As Range, Dn As Range, n As Long, nRng As Range
Set Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn
    Else
        If nRng Is Nothing Then Set nRng = _
       Dn Else Set nRng = Union(nRng, Dn)
        .Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) +    Dn.Offset(, 3)
    End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub

This is the data.

Upvotes: 1

Views: 313

Answers (1)

Vityata
Vityata

Reputation: 43595

In general, your idea to use a dictionary is probably a good one. However, I did not see how you pass keys to it, thus this is a quick solution:

Option Explicit

Public Sub TestMe()

    Dim colCount    As Long
    Dim myCell      As Range
    Dim counter     As Long

    colCount = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

    For counter = colCount To 1 Step -1
        If Cells(4, counter) <> "DriverName" And Cells(4, counter) <> "Duration" Then
            Columns(counter).Delete
        End If
    Next counter       

End Sub

The code assumes that the header of the table would be always row 4. Once this assumption is ready, with the help of Excel VBA- Finding the last column with data we define the last column with data and we start a loop from it to column 1, checking whether the Cells(4, counter) is not a DriverName or Duration. In case that it is not, we delete it.

You may consider declaring a worksheet later, as far as the current code will always refer to the activesheet - Declaring variable workbook / Worksheet vba.

The idea of setting everything to a Union Range is a better one indeed, because then the deletion is done only once and it is faster (however, in your case with less than 100 columns it will not be noticeable).

Concerning the "Remove Duplicates", take a look here - Delete all duplicate rows Excel vba.

Upvotes: 1

Related Questions