Sub Totalling

April 20th, 2004, 08:48 AM

I am trying to run a sub total where the sub total is shown in the next column not the same column, as the wizard in Excel does.
I use the following code that matches similar values in one column then adds them together and displays the result in the same column
Sub Button1_Click()

Dim dblSum As Double

Range("B5").Select
Do Until IsEmpty(ActiveCell)
    dblSum = ActiveCell.Offset(0, 1)
    Do While ActiveCell = ActiveCell.Offset(1, 0)
        dblSum = dblSum + ActiveCell.Offset(1, 1)
        ActiveCell.EntireRow.Delete
    Loop
    ActiveCell.Offset(0, 1) = dblSum
    ActiveCell.Offset(1, 0).Select
Loop

End Sub
This procedure deleted lines and leaves the final total only
What I want to do is have all the initial data in place at the end with each subtotal shown alongside final entry of the croup - I hope that makes sense.- something like
ABC123 Â£56.00
ABC123 Â£22.00
ABC123 Â£13.00 Â£91.00
BBD176 Â£25.00
BBD176 Â£12.00 Â£37.00
Hope that helps - can anyone be an inspiration to me?
Thanks in advance
Peter

embreyo · April 20th, 2004, 10:24 AM

You just need to make a few changes to the code sample you posted.

Quote:

quote:Sub Button1_Click()

Dim dblSum As Double

Range("B5").Select
Do Until IsEmpty(ActiveCell)
    dblSum = ActiveCell.Offset(0, 1)
    Do While ActiveCell = ActiveCell.Offset(1, 0)
        dblSum = dblSum + ActiveCell.Offset(1, 1)
        ActiveCell.EntireRow.Delete
    Loop
    ActiveCell.Offset(0, 1) = dblSum
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

Change your script to this:

Code:

Sub Button1_Click()

Dim dblSum As Double

Range("B5").Select
Do Until IsEmpty(ActiveCell)
    dblSum = ActiveCell.Offset(0, 1)
    Do While ActiveCell = ActiveCell.Offset(1, 0)
        dblSum = dblSum + ActiveCell.Offset(1, 1)
'        the following line was deleting the active row
'        ActiveCell.EntireRow.Delete
       Loop
'    the following line places the subtotal in the last line for the item
    ActiveCell.Offset(0, 2) = dblSum
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

Darrell L. Embrey

embreyo · April 20th, 2004, 10:50 AM

Just checking over my previous post and noticed it will not do what you desire. Here are some additional changes to achieve your desired result.

Code:

Sub Button1_Click()

Dim dblSum As Double

Range("B5").Select
Do Until IsEmpty(ActiveCell)
    dblSum = ActiveCell.Offset(0, 1)
    Do While ActiveCell = ActiveCell.Offset(1, 0)
        dblSum = dblSum + ActiveCell.Offset(1, 1)
'        the following line was deleting the active row
'        ActiveCell.EntireRow.Delete
'    move the cursor to the next row
        ActiveCell.Offset(1, 0).Activate
       Loop
'    the following line places the subtotal in the last line for the item
    ActiveCell.Offset(0, 2) = dblSum
'    the following line moves to the next row containing a new item to subtotal
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

Darrell L. Embrey

April 22nd, 2004, 11:09 AM

Darrell, Thank you very much for your help, worked very well
Peter