Sum and Delete Duplicate Rows

[RossH94]

Hi All,

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 Test
Dim Rng As Range, Dn As Range, n As Long, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & 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

 

[footoo]

What adds up correctly? The sum function or the macro?

What about :
Does Jason Ashton only appear on rows 10/11/12 or also on other rows? How is your original data sorted?

 

[RossH94]

The sum adds up correctly, Jason Ashton is on the following rows:

260 to 283 then 285 to 632

The data is sorted in ascending order according to the StartTimestamp column.

 

[footoo]

Revision to macro :
.NumberFormat = "[hh]:mm:ss"

 

[RossH94]

Revision to macro :
.NumberFormat = "[hh]:mm:ss"

Thank you! That works perfectly. How would I change your code to calculate distance instead of time?

 

[footoo]

Thank you! That works perfectly. How would I change your code to calculate distance instead of time?

Sub Test()
Dim rng As Range
[D1:D2] = [A1:A2].Value
[A:C,F:K,M:M].Delete
[C4] = "Distance"
Set rng = Range([C5], Cells(Rows.Count, "A").End(xlUp)(1, 3))
With rng
    .NumberFormat = "#,##0.0"
    .Formula = "=SUMIF(" & .Offset(0, -2).Address & ",A5," & .Offset(0, -1).Address & ")"
    .Value = .Value
    .Offset(0, -2).Resize(, 3).RemoveDuplicates Columns:=1, Header:=xlNo
End With
[B:B].Delete
End Sub

 

[RossH94]

Sub Test()
Dim rng As Range
[D1:D2] = [A1:A2].Value
[A:C,F:K,M:M].Delete
[C4] = "Distance"
Set rng = Range([C5], Cells(Rows.Count, "A").End(xlUp)(1, 3))
With rng
    .NumberFormat = "#,###.#"
    .Formula = "=SUMIF(" & .Offset(0, -2).Address & ",A5," & .Offset(0, -1).Address & ")"
    .Value = .Value
    .Offset(0, -2).Resize(, 3).RemoveDuplicates Columns:=1, Header:=xlNo
End With
[B:B].Delete
End Sub

Brilliant, thank you! I'm very greatful for all your help.