Combine Rows if Specific Data is the same

I have some timesheet data that I need to simplify and can't seem to find a macro anywhere. I've seen some similar stuff but need a vba to modify the actual data as I use several other macro's after this step to modify the data/appearance farther.

During the day we may work on a Case several different times so we create several entries in the case.

I need a macro that compares each row to all of the others as the data often isn't right next to each other, and then combines it. If the Case Number (G), Billable Status (B), and Date (A) are the same I want to merge the two rows but add the two durations together for both columns Minutes (E) and Hours (F)

Sample Data:

Data(A) Bill(B) Contact(C)  Customer(D) Min(E)  Hours(F)Case#(G)
----------------------------------------------------------------
7/5/2011    No  Lynda       Customer1   15.000  0.25    524503
7/5/2011    No  Adam        Customer2   15.000  0.25    523592
7/5/2011    No  Adam        Customer2   15.000  0.25    523592
7/6/2011    No  Adam        Customer2   15.000  0.25    523592

So the macro needs to combine the rows to look like:

7/5/2011   开发者_如何学Python No  Lynda       Customer1   15.000  0.25    524503
7/5/2011    No  Adam        Customer2   30.000  0.5     523592
7/6/2011    No  Adam        Customer2   15.000  0.25    523592

Any takers? Thanks!

Did you drafted some code? We can try to help you out to reach your solution, improving your code...

I'd go this way (if you don't know how to build the code, ask and we'll help you out):

• Create a Dictionary object (best way to get rid of duplicated info in VBA)
• Scan every row, adding into the Dictionary key the concatenation of all index values, and as a value for this key, an array with each column's value
• When is detected that the key already exists, do the sum of the desided columns (minutes, for instance)
• Print back the Dictionary into the Spreadsheet

Voilà.

Sample Code, that does part of the trick (does not print back, but sums the values and store them back into the Dictionary).

I'm storing directly the cells instead of their values just because I don't have much time now to handle the arrays...

Edit: To use scripting.dictionary, go to tools / references and check 'Microsoft Scripting Runtime'.

Edit #2: Added the code to print grouped data back. You may need to adapt the code to your requests... but it's answering your question.

Option Explicit

Sub test()

    Dim oRange As Excel.Range
    Dim oTarget As Excel.Range
    Dim oRow As Excel.Range
    Dim oRowAmend As Excel.Range
    Dim oDic As Scripting.Dictionary
    Dim sIndex As String
    Dim vKey As Variant
    Dim vItem As Variant

    'Define the source range. Remember to bypass the header!
    Set oRange = Sheets("MySheet").Range("A2:G5")

    'Define where the updated data will be printed...
    Set oTarget = Sheets("MySheet").Range("A12:G12")

    Set oDic = New Scripting.Dictionary

    For Each oRow In oRange.Rows

        'Define Indexes
        sIndex = Trim(oRow.Cells(1)) & Trim(oRow.Cells(2)) & Trim(oRow.Cells(3))

        'If the index exists, sum the values
        If oDic.Exists(sIndex) Then

            Set oRowAmend = oRow

            oRowAmend.Cells(5).Value = oRow.Cells(5).Value + oRowAmend.Cells(5).Value

            oDic.Remove (sIndex)
            oDic.Add sIndex, oRowAmend

        'If does not exist, only store their values
        Else

            oDic.Add sIndex, oRow

        End If

    Next oRow

    For Each vKey In oDic

        vItem = oDic.Item(vKey)
        oTarget = vItem

        'Points oTarget for next row...
        Set oTarget = oTarget.Offset(1, 0)

    Next vKey

End Sub

Hope it helps.