Summarise data with VBA

Microsoft Microsoft excel 2007 open lice...
May 3, 2010 at 05:01:29
Specs: Windows 7 64, 2.6Ghz/ 4Gb
I need some help please.
I have a list of accounts with amounts. There should only be one occurence for each account. Therefor they should be added up:
Account Amount
1 - 10.00
1 - 12.00
1 - 10.00
2 - 15.00
3 - 11.00
3 - 20.00
4 - 25.00
4 - 10.00

The result should be:
1 - 32.00
2 - 15.00
3 - 31.00
4 - 35.00

See More: Summarise data with VBA

May 3, 2010 at 07:42:59
It's pretty easy to do in VBA, but it's largely unnecessary.

Report •

May 3, 2010 at 08:09:26
While Pivot Tables and or VBA might be useful in this case, if all you are trying to do is SUM the values for each account, why not try this:


If you use Data...Filter...Advanced Filter to create a list of unique accounts numbers in a range, e.g. in C1:C4, then you can put this in C1 and drag it down:


Report •

May 3, 2010 at 08:44:18
Thanks for the reply it can work. My only problem is there are thousants of account numbers and I do not know beforehand which numbers are going to be in the list. I get the data from a flat file everyday.

Report •

Related Solutions

May 3, 2010 at 09:30:29
That's why I suggested the Advanced Filter Feature to extract a unique list of Account numbers.

If you don't want to Filter the data manually each day, the code below will filter the data into Column C and place the SUMIF formulas in Column D.

It assumes Account Numbers in Column A and Account Values in Column B.

Sub SumAccounts()
Dim lastAcct, lastFiltAcct As Integer
'Determine Last Row in Column A (Unfiltered Accounts)
  lastAcct = Range("A" & Rows.Count).End(xlUp).Row
'Filter Unique Acct Numbers into Column C
    Range("A1:A" & lastAcct).AdvancedFilter Action:=xlFilterCopy, _
      CopyToRange:=Range("C1"), Unique:=True
'Determine last Row in Column C (Filtered Accounts)
   lastFiltAcct = Range("C" & Rows.Count).End(xlUp).Row
'Place SUMIF Formula in Column D
    Range("D2:D" & lastFiltAcct).FormulaR1C1 = _
        "=SUMIF(R2C1:R" & lastAcct & "C1,RC[-1],R2C2:R" & lastAcct & "C2)"
End Sub

Report •

May 3, 2010 at 09:47:03
wikus: I get the data from a flat file everyday.
If it's a true flat file, you might want to eschew Excel altogether and just use VBScript to do what you want.

Regardless, here's my VBA:

Sub a()
  Dim colA As Range, c As Range
  Dim dic As Object, d As Variant
  Set dic = CreateObject("Scripting.Dictionary")
  Set colA = Sheets(1).Range(Sheets(1).Cells(1), Sheets(1).Cells.SpecialCells(xlCellTypeLastCell))
  Set colA = Intersect(Sheets(1).Range("A:A"), colA)

  For Each c In colA
    dic(c.Value) = dic(c.Value) + c.Offset(0, 1).Value
  Next c
  Set c = Sheets(2).Cells(1)
  For Each d In dic
    c = d
    c.Offset(0, 1) = dic(d)
    Set c = c.Offset(1, 0)
  Next d
End Sub

Report •

May 3, 2010 at 10:42:01
It worked prefectly, thanks very much.

Report •

May 3, 2010 at 11:42:30
errr....What worked perfectly?

You were offered a number of choices...just curious as to which one you chose.

P.S. Be careful when using SpecialCells(xlCellTypeLastCell))

Since xlCellTypeLastCell looks at cell formatting, not just cells with data, you may get undesirable results.

Drop this code into a blank workbook and run it.

It's just something to be aware of.

Sub TestLastCell()
'Fill A1:A10 with numbers
 For num = 1 To 10
  Sheets(1).Cells(num, 1) = num
'Display xlCellTypeLastCell
  MsgBox Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address
'Format E237
   Sheets(1).Cells(237, 5).Font.Bold = True
'Display xlCellTypeLastCell
  MsgBox Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address
End Sub

Report •

May 3, 2010 at 12:01:04
errr....What worked perfectly?
I offered 5 solutions, but yours was the one voted up. It's best to assume yours.

Be careful when using SpecialCells(xlCellTypeLastCell))
Meh, worst case he runs a few more permutations than he really needs.

I'd love to see how much it'd affect performance, but not enough to actually perform real world tests.

Report •

May 3, 2010 at 12:30:12

Your code was voted up also. ;-)

As far as the SpecialCells issue, I wasn't saying that it would cause major issues in this specific case, just that it can give unexpected results, in general.

Based on my reading, it appears that most coders tend to use the .End(xlup) method since they can be more specific about which Column(s) they are checking and don't have to be concerned that cell formatting will impact their result.

It was not intended as a "put-down" of your code, just a point of interest.

Report •

May 3, 2010 at 12:49:45
It's more of a, "I still use Excel 2K," issue more than anything.

Report •

May 3, 2010 at 22:17:29
I am using the Sub SumAccounts()
for now, haven't had time to test the other suggestions.
Thanks for everybody's help.

Report •

Ask Question