Solved: Sum unique values in a range

[kevvukeka]

Hi All,

I need some help with to sum unique values in a range based on another cell value.

I have Name in Column Name and Billed Amount in Col B:

I need the Sum of unique values in col B. For e.g in attached sheet

COl A has Names="Mango", COl B has Billed Amounts. Few of which are repetitive. I need such repetititves to get summed only once. I couldn't use a pivot. Can someone suggest some way around for this?

[lotuxel]

Try to use this formula
=DSUM(A1:B9,B1,A1:A2)

[mancubus]

with SUMIF

[vba]=SUMIF(A2:A9,"Mango",B2:B9)[/vba]

or
[vba]=SUMIF(A2:A9,H1,B2:B9)[/vba]
where H1 value is Mango.

[Kenneth Hobs]

[VBA]' =SUM(uniquevalues(B2:B9))
Public Function UniqueValues(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
colUniques.Add vCell, CStr(vCell)
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0

ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next i

UniqueValues = vUnique
End Function

[/VBA]

[snb]

[VBA]
Sub M_snb()
sn = Sheets("fruits").Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
.Item(sn(j, 1)) = .Item(sn(j, 1)) + sn(j, 2)
Next

Sheets("fruits").Cells(20, 1).Resize(.Count) = Application.Transpose(.keys)
Sheets("fruits").Cells(20, 2).Resize(.Count) = Application.Transpose(.items)
End With
End Sub
[/VBA]

[Kenneth Hobs]

Of course there are several ways to do it. Like the dictionary method, collections can be used in a similar way somewhat. The function goes in a Module and the first line is an example use as a UDF in a cell.

[VBA]' =SUM(UniqueValues(B2:B9))
Public Function UniqueValues(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
colUniques.Add vCell, CStr(vCell)
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0
'MsgBox colUniques.Count
ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next i

UniqueValues = vUnique
End Function[/VBA]

[snb]

Probably more robust:

[VBA]Sub M_snb()
sn = Sheets(1).Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
.Item(sn(j, 1)) = .Item(sn(j, 1)) + sn(j, 2)
Next

For Each it In .keys
.Item(it) = Array(it, .Item(it))
Next

Sheets(1).Cells(20, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
End With
End Sub[/VBA]

[Tom Jones]

Probably more robust:

[vba]Sub M_snb()
sn = Sheets(1).Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
.Item(sn(j, 1)) = .Item(sn(j, 1)) + sn(j, 2)
Next

For Each it In .keys
.Item(it) = Array(it, .Item(it))
Next

Sheets(1).Cells(20, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
End With
End Sub[/vba]

snb

None of your code is not complied with OP requirement
"Sum unique values ​​in the range"

[snb]

In that case:

[vba]
Sub M_snb()
With ActiveSheet.ListObjects.Add(1, Range("$A$1:$B$9"), , 1)
.Name = "snb_001"
.Range.RemoveDuplicates Array(1, 2), 1
.ShowTotals = True
End With
End Sub
[/vba]

[kevvukeka]

Hi Snb, Kenneth, lotuxel, mancubus...

Thanks for your help.. I got a handful of solutions now coz of you guys.

Thanks a ton...