I have a spreadsheet will a large amount of invoice numbers, some of
which are multiple occurrences of the same number. I need to count the
duplicates as one unique record and sum but I need to sum the total $
amount of each amount attached to each occurrence. For Example, say
Invoice Number W234678 has 10 occurrences and corresponding amounts. I
need the amounts to be added to give a total amount for that number
and then have Invoice Number W234678 added to the count as one
record.
I had this code kindly borrowed from this board which helped me find
the duplicates but it is not meeting my needs.

Thanks in advance for any help!

Change your 2nd For...Next loop to:

For Each vKey In .keys
Cells(lrow, "J") = vKey
Cells(lrow, "K") = .Item(vKey)
lrow = lrow + 1
Next vKey

Can't help you with the $ since you didn't say where they were, but
SUIMIF's might suffice.

Hth,
Merjet

On Mar 14, 8:46 am, "merjet" wrote:
Change your 2nd For...Next loop to:

For Each vKey In .keys
Cells(lrow, "J") = vKey
Cells(lrow, "K") = .Item(vKey)
lrow = lrow + 1
Next vKey

Can't help you with the $ since you didn't say where they were, but
SUIMIF's might suffice.

Hth,
Merjet

The corresponding dollar amounts are in B.

I don't know if I made myself clear enough.
Here is a portion of the data. I have sheets of many entries like
this.

Amount Invoice Num Invoice Date
$1,266.00 W100171 1/9/2006
$1,640.00 W102162 1/20/2006
$456.00 W103401 1/30/2006
$580.00 W103401 1/30/2006
$7,194.00 W103401 1/30/2006

Notice that Invoice Number W103401 has multiple transactions on date
1/30/2006. I need to count W103401 as one order but add up the amounts
from each transaction that for W103401

The desired result that I need displayed would be:

Amount Invoice Num Invoice Date
$1,266.00 W100171 1/9/2006
$1,640.00 W102162 1/20/2006
$8,230.00 W103401 1/30/2006

The code you posted produced a list of invoice numbers with 1
instance. My modification to it adds invoice numbers with only 1
instance. You could use that list and SUMIF's to get $ amts. If you
want to sum and combine data across multiple sheets, that is a
different matter.

Merjet

Here's a different approach using Autofilter and the Subtotal function:
Sub SubTotalUniques()
Dim Uniques As Collection
Dim r As Range
Dim r2 As Range
Dim c As Range
Dim cnt As Long
Const ic As Long = 1 'Invoice Column change to suit
Const sc As Long = 2 'Sum Column change to suit
Const afr As String = "A1" 'Autofilter start Range change to suit
If Not ActiveSheet.FilterMode Then ActiveSheet.Range(afr).AutoFilter
Set r = ActiveSheet.AutoFilter.Range
Set Uniques = New Collection
On Error Resume Next ' ignore any errors
For Each c In r.Columns(1).Resize(r.Rows.Count - 1).Offset(1).Cells
Uniques.Add c.Value, CStr(c.Value) ' add the unique item
Next
On Error GoTo 0
Set r2 = r.Cells(r.Rows.Count, 1).Offset(2)
r2 = "=SUBTOTAL(109," & r.Columns(2).Resize _
(r.Rows.Count - 1).Offset(1).Address & ")"
For cnt = 1 To Uniques.Count
r.AutoFilter Field:=r.Columns(1).Column, Criteria1:=Uniques(cnt)
Worksheets("Sheet2").Range("A" & cnt) = Uniques(cnt)
Worksheets("Sheet2").Range("B" & cnt) = r2.Value
Next
ActiveSheet.AutoFilterMode = False
r2.Delete Shift:=xlUp
End Sub

Let me know if you have problems.
--
Charles Chickering

"A good example is twice the value of good advice."


"allie357" wrote:

I have a spreadsheet will a large amount of invoice numbers, some of
which are multiple occurrences of the same number. I need to count the
duplicates as one unique record and sum but I need to sum the total $
amount of each amount attached to each occurrence. For Example, say
Invoice Number W234678 has 10 occurrences and corresponding amounts. I
need the amounts to be added to give a total amount for that number
and then have Invoice Number W234678 added to the count as one
record.
I had this code kindly borrowed from this board which helped me find
the duplicates but it is not meeting my needs.

Thanks in advance for any help!

Code:

 Dim rCell As Range, rRng As Range, vKey, lrow As Long
 
 
 
 Set rRng = Range("F2:F199")
 
 
 
 With CreateObject("Scripting.dictionary")
 
     .comparemode = vbTextCompare
 
 
 
     ' load the info
 
     For Each rCell In rRng
 
         If Not .exists(rCell.Value) Then _
 
             .Add rCell.Value,
 Application.WorksheetFunction.CountIf(rRng, rCell.Value)
 
     Next rCell
 
 
 
     ' Write the result in columns J:K
 
     lrow = 2
 
     For Each vKey In .keys
 
         If .Item(vKey)  1 Then
 
             Cells(lrow, "J") = vKey
 
             Cells(lrow, "K") = .Item(vKey) - 1
 
             lrow = lrow + 1
 
         End If
 
     Next vKey
 
 End With
 
 End Sub