Count totals for the same accounts

  • Thread starter Thread starter Loop
  • Start date Start date
L

Loop

Hi all,
I'm new in VBA.
Could anyone helps me with vba code in excel to count totals? I have
two columns:

Account Amount
19216801 5
19216803 10
19216808 2
19216801 3
19216801 5
19216803 6
19216801 34
19216801 21
19216808 45

I'd like to see them like this:
Account Amount
19216801 68
19216803 16
19216808 47

Thanks
 
Also I need to compare the dinal data with the data on another sheet
(the same accounts but different totals) to get difference.

Thanks,
 
Have you tried a Pivot Table or Subtotals?
Data > Text to Column > Space > Finish
Insert a row on the top. Data > Pivot Table > Finish
If you use a subtotal, sort the data > Data > Subtotal > Sum > Add subtotal
to...Ok

HTH,
Ryan---
 
Have you tried a Pivot Table or Subtotals?
Data > Text to Column > Space > Finish
Insert a row on the top.  Data > Pivot Table > Finish
If you use a subtotal, sort the data > Data > Subtotal > Sum > Add subtotal
to...Ok

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''..






- Show quoted text -

I can do it using a Pivot table but I'd like to get a vba code.

Thanks,
 
The totals for each can be calculated using an array for all the data and
then looking for each account #:

Sub CountArray()

Dim arrCount As Variant
With Sheets("Sheet1")
arrCount = .Range(.Range("A2"), .Range("A2").End(xlDown) _
.End(xlToRight)).Value
End With

Dim ac19216801, ac19216803, ac19216808 As Long
Dim i As Long

For i = LBound(arrCount, 1) To UBound(arrCount, 1)
If arrCount(i, 1) = 19216801 Then
ac19216801 = ac19216801 + arrCount(i, 2)
ElseIf arrCount(i, 1) = 19216803 Then
ac19216803 = ac19216803 + arrCount(i, 2)
ElseIf arrCount(i, 1) = 19216808 Then
ac19216808 = ac19216808 + arrCount(i, 2)
End If

Next

With Sheets("Sheet1")
.Range("B16").Value = ac19216801
.Range("B17").Value = ac19216803
.Range("B18").Value = ac19216808
End With

End Sub
 
The totals for each can be calculated using an array for all the data and
then looking for each account #:

Sub CountArray()

    Dim arrCount As Variant
        With Sheets("Sheet1")
            arrCount = .Range(.Range("A2"), .Range("A2").End(xlDown) _
                             .End(xlToRight)).Value
        End With

    Dim ac19216801, ac19216803, ac19216808 As Long
    Dim i As Long

    For i = LBound(arrCount, 1) To UBound(arrCount, 1)
        If arrCount(i, 1) = 19216801 Then
            ac19216801 = ac19216801 + arrCount(i, 2)
        ElseIf arrCount(i, 1) = 19216803 Then
            ac19216803 = ac19216803 + arrCount(i, 2)
        ElseIf arrCount(i, 1) = 19216808 Then
            ac19216808 = ac19216808 + arrCount(i, 2)
        End If

    Next

    With Sheets("Sheet1")
        .Range("B16").Value = ac19216801
        .Range("B17").Value = ac19216803
        .Range("B18").Value = ac19216808
    End With

End Sub
 
The totals for each can be calculated using an array for all the data and
then looking for each account #:

Sub CountArray()

    Dim arrCount As Variant
        With Sheets("Sheet1")
            arrCount = .Range(.Range("A2"), .Range("A2").End(xlDown) _
                             .End(xlToRight)).Value
        End With

    Dim ac19216801, ac19216803, ac19216808 As Long
    Dim i As Long

    For i = LBound(arrCount, 1) To UBound(arrCount, 1)
        If arrCount(i, 1) = 19216801 Then
            ac19216801 = ac19216801 + arrCount(i, 2)
        ElseIf arrCount(i, 1) = 19216803 Then
            ac19216803 = ac19216803 + arrCount(i, 2)
        ElseIf arrCount(i, 1) = 19216808 Then
            ac19216808 = ac19216808 + arrCount(i, 2)
        End If

    Next

    With Sheets("Sheet1")
        .Range("B16").Value = ac19216801
        .Range("B17").Value = ac19216803
        .Range("B18").Value = ac19216808
    End With

End Sub

Thanks a lot for answering. No offence but it's not gonna work. I have
thousands rows. To write a code like this I'd spend hours.
Is it possible to to do a loop compare the first account in a row with
next one until the end. Then second one starts. But if it already was
counted, skip it.

Thanks,
 
It can be done using SQL and embedding the SQL query in a VBA procedure
(using ADO). It requires adding a reference to the ADO library in your
project. Tools > References > Microsoft ActiveX Data Objects Library.

This was done in Excel 2003, using the Acess 2003 database engine (JET). I
hope this formats okay.

Option Explicit

Sub QueryExcel()

'create the connection string
Dim ConnectionString As String

ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;" & _
"Data Source=K:\Excel\jun09\Aug13.xls;" & _
"Extended Properties=Excel 8.0;"

'create the sql query
Dim MyQuery As String

MyQuery = "SELECT Account, SUM(Amount) " & _
"FROM [DataSheet$] " & _
"GROUP BY Account " & _
"ORDER BY Account"

'create the recordset
Dim MyRS As ADODB.Recordset
Set MyRS = New ADODB.Recordset

'open the recordset
MyRS.Open MyQuery, ConnectionString, adOpenStatic, adLockReadOnly,
adCmdText

ThisWorkbook.Sheets("Summary").Activate
ActiveSheet.Range("A1").CopyFromRecordset MyRS

MyRS.Close
Set MyRS = Nothing

End Sub

Note: You'll have to change the path in the connection string. Also the way
it's setup requires the original data & the summary you're creating to be in
different workbooks.
 
It can be done using SQL and embedding the SQL query in a VBA procedure
(using ADO). It requires adding a reference to the ADO library in your
project. Tools > References > Microsoft ActiveX Data Objects Library.

This was done in Excel 2003, using the Acess 2003 database engine (JET). I
hope this formats okay.

Option Explicit

Sub QueryExcel()

    'create the connection string
    Dim ConnectionString As String

    ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;" & _
                                "Data Source=K:\Excel\jun09\Aug13.xls;" & _
                                "ExtendedProperties=Excel 8.0;"

    'create the sql query
    Dim MyQuery As String

    MyQuery = "SELECT Account, SUM(Amount) " & _
                     "FROM [DataSheet$] " & _
                     "GROUP BY Account " & _
                     "ORDER BY Account"

    'create the recordset
    Dim MyRS As ADODB.Recordset
        Set MyRS = New ADODB.Recordset

    'open the recordset
    MyRS.Open MyQuery, ConnectionString, adOpenStatic, adLockReadOnly,
adCmdText

    ThisWorkbook.Sheets("Summary").Activate
    ActiveSheet.Range("A1").CopyFromRecordset MyRS

    MyRS.Close
    Set MyRS = Nothing

End Sub

Note: You'll have to change the path in the connection string. Also the way
it's setup requires the original data & the summary you're creating to bein
different workbooks.

Thanks a lot. I'll try to make it work.
 
Back
Top