Count duplicates as unique record, sum amounts?

A

allie357

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
 
M

merjet

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
 
A

allie357

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
 
M

merjet

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
 
C

Charles Chickering

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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top