PDA

View Full Version : Solved: Sum unique values in a range



kevvukeka
07-09-2013, 11:26 PM
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
07-10-2013, 12:45 AM
Try to use this formula
=DSUM(A1:B9,B1,A1:A2)

mancubus
07-10-2013, 02:15 AM
with SUMIF

=SUMIF(A2:A9,"Mango",B2:B9)

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

Kenneth Hobs
07-10-2013, 09:52 AM
' =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

snb
07-11-2013, 04:08 AM
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

Kenneth Hobs
07-11-2013, 06:02 AM
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.

' =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

snb
07-11-2013, 09:13 AM
Probably more robust:

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

Tom Jones
07-11-2013, 10:42 AM
Probably more robust:

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


snb

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

snb
07-11-2013, 01:27 PM
In that case:


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

kevvukeka
07-11-2013, 10:49 PM
Hi Snb, Kenneth, lotuxel, mancubus...

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

Thanks a ton...