Summing duplicate entries and non duplicates

Hi All,

Can someone help me please. Rather than using Subtotals in excel to get the
sum of a number of common entries, can i use vba code to exacly this.

i.e

Column A has duplicate entries and also non duplicate entries and column B
has values, i want to sum up all the duplicate entries and non duplicate
entries to show just one entry in column A for each different entry and its
corresponding sum.

hope this makes sense.

thanks BigH

Hi Big,

I am just starting with programming Excel,
and there are many other solutions,
if the following can be called a solution at all.

Anyway, my test-worksheet looks like this:

a 1
c 2
b 8
c 3
a 4
d 7
e 6
f 1
g 6
a 1
g 4
h 4

And this is what I've figured out:

Sub Test1111()
Dim r1 As Long ' row
Dim r2 As Long ' row
Dim v As Long ' a value to be summed up
Dim x As Long ' last row
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
With ActiveWorksheet
For r1 = 1 To x
v = Cells(r1, 2).Value
l = 0
For r2 = 1 To x
If Cells(r1, 1).Value = Cells(r2, 1).Value Then
l = l + 1
If l > 1 Then
v = v + Cells(r2, 2).Value
Rows(r2).Delete
x = x - 1
End If
End If
Next
Next
End With
End Sub

Each cell in column 1 is compared with each cell in column 1.
If there is more than one match (l), as a cell would be compared
with itself, the value from column 2 is added and the row deleted.

Decrementing a loop variable in a loop is dangereous,
but seems to be logical here. And there is no danger,
if you know what you are doing.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA (not Excel, no way yet)

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Oops,

the most important line was missing.

If l > 1 Then
v = v + Cells(r2, 2).Value
Cells(r1, 2).Value = v ' !!!<<<<
Rows(r2).Delete
x = x - 1
End If

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

"Big H" <[email protected]> wrote in message
news:%[email protected]...
> Hi All,
>
> Can someone help me please. Rather than using Subtotals in excel to get
> the sum of a number of common entries, can i use vba code to exacly this.
>
> i.e
>
> Column A has duplicate entries and also non duplicate entries and column B
> has values, i want to sum up all the duplicate entries and non duplicate
> entries to show just one entry in column A for each different entry and
> its corresponding sum.

Just in case you want only the two sums:
-------------------------------
{=SUM(IF(COUNTIF($A$10:$A$20,$A$10:$A$20)=1,
$B$10:$B$20,0))}
FormulaArray for non duplicate entries

{=SUM(IF(COUNTIF($A$10:$A$20,$A$10:$A$20)>1,
$B$10:$B$20,0))}
FormulaArray for duplicate entries
---------------------------------


This writes the two sums in C1, C2:
------------------------------------
Sub Button30_Click()
Dim S1 As Double, S2 As Double
Dim DataRange As String, ValueRange As String
DataRange = "$A$10:$A$20"
ValueRange = "$B$10:$B$20"
[iv65535].FormulaArray = "=SUM(IF(COUNTIF(" & DataRange & _
"," & DataRange & ")=1," & ValueRange & ",0))"
[iv65536].FormulaArray = "=SUM(IF(COUNTIF(" & DataRange & _
"," & DataRange & ")>1," & ValueRange & ",0))"
S1 = [iv65535]
S2 = [iv65536]
[C1] = S1
[C2] = S2
[iv65535] = ""
[iv65536] = ""
End Sub
-------------------------------------

Bruno

Hi Helmut,

thanks for the code, it works fine. However i have around 350 enties and
when i run the code there are still some double entries once the code has
ran, i reckon i am about 95% there?

regards From Scotland
"Big H" <[email protected]> wrote in message
news:%[email protected]...
> Hi All,
>
> Can someone help me please. Rather than using Subtotals in excel to get
> the sum of a number of common entries, can i use vba code to exacly this.
>
> i.e
>
> Column A has duplicate entries and also non duplicate entries and column B
> has values, i want to sum up all the duplicate entries and non duplicate
> entries to show just one entry in column A for each different entry and
> its corresponding sum.
>
> hope this makes sense.
>
> thanks BigH
>

This sounds like a nice situation to use data|pivottables (if I understand
correctly).

Add a single row of headers (I called mine Cate (for category) and Qty.

Then select your range (A1:B13 for the sample data)

Data|pivottable
since we selected the range first, we can just follow the wizard until we get a
dialog with a button named Layout.

Click that button.
Drag the Cate button to the Row field
drag the qty button to the data field
(if the qty doesn't show "Sum of", double click on it and select Sum.)
Then finish up the wizard.

When I was done, I had a table that looked like:

Sum of qty
Cate Total
a 6
b 8
c 5
d 7
e 6
f 1
g 10
h 4
Grand Total 47


To read more about the pivottable stuff, you may want to look at some links:

Debra Dalgleish's pictures at Jon Peltier's site:
http://peltiertech.com/Excel/Pivots/pivottables.htm
And Debra's own site:
http://www.contextures.com/xlPivot01.html

John Walkenbach also has some at:
http://j-walk.com/ss/excel/files/general.htm
(look for Tony Gwynn's Hit Database)

Chip Pearson keeps Harald Staff's notes at:
http://www.cpearson.com/excel/pivots.htm

MS has some at (xl2000 and xl2002):
http://office.microsoft.com/downloads/2000/XCrtPiv.aspx
http://office.microsoft.com/assistan...lconPT101.aspx

Big H wrote:
>
> Hi All,
>
> Can someone help me please. Rather than using Subtotals in excel to get the
> sum of a number of common entries, can i use vba code to exacly this.
>
> i.e
>
> Column A has duplicate entries and also non duplicate entries and column B
> has values, i want to sum up all the duplicate entries and non duplicate
> entries to show just one entry in column A for each different entry and its
> corresponding sum.
>
> hope this makes sense.
>
> thanks BigH

--

Dave Peterson

Just a comment about this comment:

> Decrementing a loop variable in a loop is dangereous,
> but seems to be logical here. And there is no danger,
> if you know what you are doing.

Sometimes life becomes lots easier if you start at the bottom of the data and
work your way up. Then you don't have to worry about keeping track of what row
you're on (when a row is deleted).

And it's nice to always declare all your variables, too <vbg>.

Helmut Weber wrote:
>
> Hi Big,
>
> I am just starting with programming Excel,
> and there are many other solutions,
> if the following can be called a solution at all.
>
> Anyway, my test-worksheet looks like this:
>
> a 1
> c 2
> b 8
> c 3
> a 4
> d 7
> e 6
> f 1
> g 6
> a 1
> g 4
> h 4
>
> And this is what I've figured out:
>
> Sub Test1111()
> Dim r1 As Long ' row
> Dim r2 As Long ' row
> Dim v As Long ' a value to be summed up
> Dim x As Long ' last row
> x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
> With ActiveWorksheet
> For r1 = 1 To x
> v = Cells(r1, 2).Value
> l = 0
> For r2 = 1 To x
> If Cells(r1, 1).Value = Cells(r2, 1).Value Then
> l = l + 1
> If l > 1 Then
> v = v + Cells(r2, 2).Value
> Rows(r2).Delete
> x = x - 1
> End If
> End If
> Next
> Next
> End With
> End Sub
>
> Each cell in column 1 is compared with each cell in column 1.
> If there is more than one match (l), as a cell would be compared
> with itself, the value from column 2 is added and the row deleted.
>
> Decrementing a loop variable in a loop is dangereous,
> but seems to be logical here. And there is no danger,
> if you know what you are doing.
>
> --
> Greetings from Bavaria, Germany
>
> Helmut Weber, MVP WordVBA (not Excel, no way yet)
>
> Win XP, Office 2003
> "red.sys" & Chr$(64) & "t-online.de"

--

Dave Peterson

Hi everybody,

seems, I was so exited
that I forgot about option explicit.

Just another try, using a placeholder for double entries
and deleting them later.
The first attempt was no good at all, it seems,
and I'm still fooling around with Excel.
(I'll try for x to 1 step -1).

Option Explicit
Sub Test1111()
Dim r1 As Long ' row
Dim r2 As Long ' row
Dim v As Long
Dim s1 As String
Dim s2 As String
Dim x As Long ' last row
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
For r1 = 1 To x
For r2 = 1 To x
s1 = Cells(r1, 1).Value
s2 = Cells(r2, 1).Value
v = Cells(r1, 2).Value
If s1 <> "---" Then
If r1 <> r2 And s1 = s2 Then
v = v + Cells(r2, 2).Value
Cells(r1, 2).Value = v
Cells(r2, 1).Value = "---"
Cells(r2, 2).Value = 0
End If
End If
Next
Next
For r1 = 1 To x
While Cells(r1, 1).Value = "---"
Rows(r1).Delete
Wend
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA (not Excel, for sure)

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Hi,

this one looks best, so far.

And I wonder, why one has to be told,
what he told himself others a dozen times. ;-)

>Sometimes life becomes lots easier if you start at the bottom
>of the data and work your way up. Then you don't have to worry
>about keeping track of what row you're on (when a row is deleted).

Sub Test1112()
Dim r1 As Long ' row 1
Dim r2 As Long ' row 2, which is identical once to row 1
Dim v As Long ' a value to be added
Dim s1 As String ' a name
Dim s2 As String ' a name, too, which is identical once to s1
Dim x As Long ' last row
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
For r1 = x To 1 Step -1
For r2 = x To 1 Step -1
s1 = Cells(r1, 1).Value
s2 = Cells(r2, 1).Value
v = Cells(r1, 2).Value
If r1 <> r2 And s1 = s2 Then
v = v + Cells(r2, 2).Value
Cells(r1, 2).Value = v
Rows(r2).Delete
End If
Next
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA (not Excel!)

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

This line looks a little funny:
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
maybe just once <vbg>
x = Cells(Rows.Count, 1).End(xlUp).Row

And just as another alternative...
Excel has a couple of built in worksheet functions that would be nice. There's
=sumif() to add up numbers based on a criteria--and =countif() that counts items
based on a criteria.

You can use those and build a range to delete and still work from the top down.

Option Explicit
Sub testme02()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim delRng As Range
Dim myRng As Range

With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set myRng = .Range(.Cells(FirstRow, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))

'do the first row
.Cells(FirstRow, "B").Value _
= Application.SumIf(myRng, .Cells(FirstRow, "A").Value, _
myRng.Offset(0, 1))

For iRow = 2 To LastRow
If Application.CountIf(.Range(.Cells(FirstRow, "A"), _
.Cells(iRow - 1, "A")), .Cells(iRow, "A")) > 0 Then
'it's a duplicate of a previous row, so get ready to delete it
If delRng Is Nothing Then
Set delRng = .Cells(iRow, "A")
Else
Set delRng = Union(.Cells(iRow, "A"), delRng)
End If
Else
.Cells(iRow, "B").Value _
= Application.SumIf(myRng, .Cells(iRow, "A").Value, _
myRng.Offset(0, 1))
End If

Next iRow
End With

If delRng Is Nothing Then
'do nothing
Else
delRng.EntireRow.Delete
End If

End Sub

Just another way to approach the problem. (Although I like the pivottable
best.)

Another non-macro way would be to use those equivalent formulas in a couple of
helper cells. Then apply Data|filter|autofilter to delete the rows that are the
duplicates (after converting to values).

Helmut Weber wrote:
>
> Hi,
>
> this one looks best, so far.
>
> And I wonder, why one has to be told,
> what he told himself others a dozen times. ;-)
>
> >Sometimes life becomes lots easier if you start at the bottom
> >of the data and work your way up. Then you don't have to worry
> >about keeping track of what row you're on (when a row is deleted).
>
> Sub Test1112()
> Dim r1 As Long ' row 1
> Dim r2 As Long ' row 2, which is identical once to row 1
> Dim v As Long ' a value to be added
> Dim s1 As String ' a name
> Dim s2 As String ' a name, too, which is identical once to s1
> Dim x As Long ' last row
> x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
> For r1 = x To 1 Step -1
> For r2 = x To 1 Step -1
> s1 = Cells(r1, 1).Value
> s2 = Cells(r2, 1).Value
> v = Cells(r1, 2).Value
> If r1 <> r2 And s1 = s2 Then
> v = v + Cells(r2, 2).Value
> Cells(r1, 2).Value = v
> Rows(r2).Delete
> End If
> Next
> Next
> End Sub
>
> --
> Greetings from Bavaria, Germany
>
> Helmut Weber, MVP WordVBA (not Excel!)
>
> Win XP, Office 2003
> "red.sys" & Chr$(64) & "t-online.de"

--

Dave Peterson

Hi Helmut,

it works perfectly, however if i name cell a1 Material and cell b1 value,
the code runs fine and then at the end comes up with type mismatch 13, i
think its because cell b1 is not a number.

regards Harry
"Big H" <[email protected]> wrote in message
news:[email protected]...
> Hi Helmut,
>
> thanks for the code, it works fine. However i have around 350 enties and
> when i run the code there are still some double entries once the code has
> ran, i reckon i am about 95% there?
>
> regards From Scotland
> "Big H" <[email protected]> wrote in message
> news:%[email protected]...
>> Hi All,
>>
>> Can someone help me please. Rather than using Subtotals in excel to get
>> the sum of a number of common entries, can i use vba code to exacly this.
>>
>> i.e
>>
>> Column A has duplicate entries and also non duplicate entries and column
>> B has values, i want to sum up all the duplicate entries and non
>> duplicate entries to show just one entry in column A for each different
>> entry and its corresponding sum.
>>
>> hope this makes sense.
>>
>> thanks BigH
>>
>
>

Hi Dave,

I'm learning. Hopefully.

>This line looks a little funny:
>x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
>maybe just once <vbg>
>x = Cells(Rows.Count, 1).End(xlUp).Row

Indeed.

>And just as another alternative...
>Excel has a couple of built in worksheet functions that would be nice. There's
>=sumif() to add up numbers based on a criteria--and =countif() that counts items
>based on a criteria.

Thanks for the advice.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Hi Harry,

>it works perfectly, however if i name cell a1 Material and cell b1 value,
>the code runs fine and then at the end comes up with type mismatch 13, i
>think its because cell b1 is not a number.

Very probably so.
I thought, there are always numbers in column b.
Beware of empty cells. If the value is undefined,
you may substitute it by zero.

Though in a strict sense, calculations with undefined values
might be very problematic.


--
Greetings from Bavaria, Germany

Helmut Weber

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

You'll soon learn that the real fun stuff is in excel. You'll put MSWord on the
back burner and only use it when you really have to!

<gd&r>

Helmut Weber wrote:
>
> Hi Dave,
>
> I'm learning. Hopefully.
>
> >This line looks a little funny:
> >x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
> >maybe just once <vbg>
> >x = Cells(Rows.Count, 1).End(xlUp).Row
>
> Indeed.
>
> >And just as another alternative...
> >Excel has a couple of built in worksheet functions that would be nice. There's
> >=sumif() to add up numbers based on a criteria--and =countif() that counts items
> >based on a criteria.
>
> Thanks for the advice.
>
> --
> Greetings from Bavaria, Germany
>
> Helmut Weber, MVP WordVBA
>
> Win XP, Office 2003
> "red.sys" & Chr$(64) & "t-online.de"

--

Dave Peterson