check value - merge and count

Hello!

I have following problem.
I have a file with about 10,000 rows, each containing a column with a number, a date, text, text, number, number. that order, about 10,000 times.

Now I have the great honor to check all these entries for duplicates (done), BUT, and this is where it gets tricky, some entries values are exactly the same.

Example:

A - B - C - D - E - F
5 - 2009/01/01 - Bill Gates - Microsoft - 5 - 13
5 - 2009/01/15 - Bill Gates - Microsoft - 6 - 17


How do I manage to get Excel to count me that there are 2 entries, and then merge them together into one, but still showing me "2" in another colum?

WANTED RESULT:
A - B - C - D - E - F - H (!)
10 - Date does not matter - Bill Gates - Microsoft - 11 - 30 - TOTAL 2 entries

The date does not really matter and can actually be deleted. Anyway, I have been playing with CountIF but without success. any ideas?

THANKS
A2k

Hi Armitage 2K
Have you tried a pivot table ?

Something like

Sub Complicate()
    Dim lRows As Long
     Application.ScreenUpdating = False
      With Sheet2.UsedRange
        lRows = .Rows.Count
        .Columns(4).Insert
         .Columns(4).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-2]:R" & lRows & "C[-2]=RC[-2])* --(R2C[-1]:R" & lRows & "C[-1]=RC[-1]))"
        .Columns(4).Value = .Columns(4).Value
        .Resize(, 4).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Resize(, 4), CopyToRange:=Range("j1"), Unique:=True
        .Columns(4).Delete
    End With
     Application.ScreenUpdating = True
End Sub

or even more so

Sub complicate()
    Dim lRows As Long, a, iRows As Long, i As Long
     Application.ScreenUpdating = False
    a = Worksheets("Sheet2").Columns(1)
    Columns(1).Delete
      With Sheet2.UsedRange
        lRows = .Rows.Count
        .Columns(3).Insert
         .Columns(3).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-2]:R" & lRows & "C[-2]=RC[-2])* --(R2C[-1]:R" & lRows & "C[-1]=RC[-1]))"
        .Columns(3).Value = .Columns(3).Value
        .Resize(, 3).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Resize(, 3), CopyToRange:=Range("N1"), Unique:=True
        .Columns(3).Delete
        End With
    Columns(1).Insert
    Columns(1) = a
   iRows = Cells(Rows.Count, 14).End(xlUp).Row
     For i = 1 To iRows
       Worksheets("Sheet2").Cells(i, 17).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-15]:R" & iRows & "C[-15]=RC[-15] )* --(R2C[-14]:R" & iRows & "C[-14]=RC[-14])*(R2C[-13]:R" & iRows & "C[-13]))"
         Worksheets("Sheet2").Cells(i, 18).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-16]:R" & iRows & "C[-16]=RC[-16])* --(R2C[-15]:R" & iRows & "C[-15]=RC[-15])*(R2C[-13]:R" & iRows & "C[-13]))"
    Worksheets("Sheet2").Cells(i, 8).FormulaR1C1 = _
        "=R" & i & "C[6]&"" - ""& R" & i & "C[7] &"" - ""&R" & i & "C[9]& "" - "" &R" & i & "C[10] & "" - "" &R" & i & "C[8]&  "" Total Entries"""
    Next
        Columns(17).Value = Columns(17).Value
        Columns(18).Value = Columns(18).Value
        Columns(8).Value = Columns(8).Value
        Columns(14).Delete
        Columns(14).Delete
        Columns(14).Delete
        Columns(14).Delete
        Columns(14).Delete
        Range("H1").Clear
     Application.ScreenUpdating = True
End Sub

Ops..two of the sumproducts should have been sum in formula array

Sub complicated()
    Dim lRows As Long, a, iRows As Long, i As Long
     Application.ScreenUpdating = False
    a = Worksheets("Sheet1").Columns(1)
    Columns(1).Delete
      With Sheet2.UsedRange
        lRows = .Rows.Count
        .Columns(3).Insert
         .Columns(3).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-2]:R" & lRows & "C[-2]=RC[-2])* --(R2C[-1]:R" & lRows & "C[-1]=RC[-1]))"
        .Columns(3).Value = .Columns(3).Value
        .Resize(, 3).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Resize(, 3), CopyToRange:=Range("N1"), Unique:=True
        .Columns(3).Delete
       .Columns(1).Insert
    .Columns(0) = a
   iRows = Cells(Rows.Count, 14).End(xlUp).Row
     For i = 1 To iRows
      .Cells(i, 16).FormulaArray = _
        "= SUM(--(R2C[-15]:R" & lRows & "C[-15]=RC[-3] )*(R2C[-14]:R" & lRows & "C[-14]=RC[-2])*(R2C[-13]:R" & lRows & "C[-13]))"
         .Cells(i, 17).FormulaArray = _
        "= SUM((R2C[-16]:R" & lRows & "C[-16]=RC[-4])* (R2C[-15]:R" & lRows & "C[-15]=RC[-3])*(R2C[-13]:R" & lRows & "C[-13]))"
    .Cells(i, 8).FormulaR1C1 = _
        "=R" & i & "C[5]&"" - ""& R" & i & "C[6] &"" - ""&R" & i & "C[8]& "" - "" &R" & i & "C[9] & "" - "" &R" & i & "C[7]&  "" Total Entries"""
    Next
      End With
         Columns(9).Value = Columns(9).Value
       Columns(17).Value = Columns(17).Value
       Columns(18).Value = Columns(18).Value
       For x = 1 To 5
        Columns(14).Delete
       Next x
        Range("I1").Delete
     Application.ScreenUpdating = True
End Sub

you'll need to change the sheet number/name to your value

even confused myself
use

Sub very_complicated()
Dim lRows As Long, iRows As Long, i As Long, x As Long
   Application.ScreenUpdating = False
    With Sheet1.UsedRange
        lRows = .Rows.Count
        .Columns(5).Insert
        .Columns(5).FormulaR1C1 = _
        "= SUMPRODUCT(--(R2C[-2]:R" & lRows & "C[-2]=RC[-2])* --(R2C[-1]:R" & lRows & "C[-1]=RC[-1]))"
        .Columns(5).Value = .Columns(5).Value
        .Range("C1:E" & lRows).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("C1:E1"), CopyToRange:=Range("N1"), Unique:=True
        .Columns(5).Delete
        iRows = Cells(Rows.Count, 14).End(xlUp).Row
        For i = 1 To iRows
            .Cells(i, 16).FormulaArray = _
            "= SUM(--(R2C[-13]:R" & lRows & "C[-13]=RC[-3] )*(R2C[-12]:R" & lRows & "C[-12]=RC[-2])*(R2C[-11]:R" & lRows & "C[-11]))"
            .Cells(i, 17).FormulaArray = _
            "= SUM((R2C[-14]:R" & lRows & "C[-14]=RC[-4])* (R2C[-13]:R" & lRows & "C[-13]=RC[-3])*(R2C[-11]:R" & lRows & "C[-11]))"
            .Cells(i, 12).FormulaArray = _
            "= SUM((R2C[-9]:R" & lRows & "C[-9]=RC[1])* (R2C[-8]:R" & lRows & "C[-8]=RC[2])*(R2C[-11]:R" & lRows & "C[-11]))"
            .Cells(i, 8).FormulaR1C1 = _
            "=R" & i & "C[4]&"" - ""&R" & i & "C[5]&"" - ""& R" & i & "C[6] &"" - ""&R" & i & "C[8]& "" - "" &R" & i & "C[9] & "" - "" &R" & i & "C[7]&  "" Total Entries"""
        Next
    End With
    Columns(8).Value = Columns(8).Value
    For x = 1 To 6
        Columns(12).Delete
    Next x
    Range("H1").Value = "List"
    Application.ScreenUpdating = True
end sub