Subtotaling a report

[austenr]

I have a report that I download into EXCEL. I need to loop through the file and on a division break (Column c) I need to write totals for that division and the premium total also (Column m). I want the report on sheet 2 of the workbook and need it to look like the following:


Division 1 Totals Member count xxxx Premium $$$$$$$$

With a grand total at the end totaling all divisions. Can anyone direct me to an example I could use? Thanks in advnace for your help.

Have not done much VBA recently, redesigning a site so I am a little rusty.

[Zack Barresse]

Hi Austen,

How about using the built in Subtotals feature? Data --> Subtotals.

[austenr]

Hi I tried that but was hoping for something better. Where I can write a mini report at the end of the file on a seperate sheet. In other words, write a total line to sheet two every time a change in division occirs.

[MrExcel]

Here is what I would do:

1) Use the .AdvancedFilter method with Unique:=True and CopyToNewLocation.

This will get you a list of the unique divisions.

Then - once you have those divisions, write a .Formula = "=SUMIF(...)" to get the totals for each division.

It would run fast - the .AdvancedFilter works great.

Bill

[austenr]

Not exactly sure how to use that. I tried looking at it but was a little unsure on how to use it. Is there a way to use Subtotal to count the number of occurences in a division and also sum the total of sales without passing the data through twice?

[MrExcel]

All of this code is from Chapter 11 of VBA & Macros for Microsoft Excel, published by QUE.

First, you need to find a unique list of divisions in column C.


Dim IRange As Range
Dim ORange As Range
' Find the size of today's dataset
FinalRow = Cells(65536, 3).End(xlUp).Row
NextCol = Cells(1, 255).End(xlToLeft).Column + 2
' Set up output range. Copy heading from C1 there
Range("C1").Copy Destination:=Cells(1, NextCol)
Set ORange = Cells(1, NextCol)
' Define the Input Range
Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
' Do the Advanced Filter to get unique list of customers
IRange.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ORange, Unique:=True
'This will set up a new little summary off to the right of your data with just the unique divisions.
' Determine how many unique Divisions we have
LastRow = Cells(65536, NextCol).End(xlUp).Row
' Sort the data
Cells(1, NextCol).Resize(LastRow, 1).Sort _
Key1:=Cells(1, NextCol), Order1:=xlAscending, _
Header:=xlYes
' Add an array formula to get totals
Cells(1, NextCol + 1).Value = "Revenue"
Cells(2, NextCol + 1).FormulaArray = "=SUM((R2C3:R" & FinalRow & "C3=RC[-1])*R2C13:R" & FinalRow & "C13)"
Cells(1, NextCol + 2).value = "Count"
Cells(2, NextCol + 1).FormulaR1C1 = _
"=COUNTIF(R2C3:R" & FinalRow & "C3,RC[-2])"
' Copy the formula
If LastRow > 2 Then
Cells(2, NextCol + 1).Resize(1, 2).Copy _
Cells(3, NextCol + 1).Resize(LastRow - 2, 2)
End If

[austenr]

Does not compile. FinalRow not defined. So let me see if I have this correct...


This will total how many salesmen in each division (Column C) and the total number of sales (Column M)? Thanks for your help...

[Ken Puls]

Hi Austen,

Sounds like you're using Option Explicit! :thumb

I think you'll need to add:


Dim FinalRow as Long, NextCol as Long, LastRow as Long

HTH,

[austenr]

This works great for the number of sales in column C, but I also need the total sales in column M. What do I have to modify?

[Ken Puls]

Hi Austen,

Only had a brief moment to read the code, but is it giving you the total sales in column B right now? If so, modify these two lines:


Cells(1, NextCol + 1).Value = "Revenue"
Cells(2, NextCol + 1).FormulaArray = "=SUM((R2C3:R" & FinalRow & "C3=RC[-1])*R2C13:R" & FinalRow & "C13)"

Change the NextCol + 1 to NextCol + (how ever many columns you want to move it over)

HTH,

[austenr]

well if i change that i get zeros. So tell me to get totals like i get now reading column C what must I change to make it work for column m?

[Ken Puls]

Hi austen,

Any way you can upload a small amount of sample data? I'm not really sure what the code is starting it's work with, so it would be easier.

Change the name to protect the innocent, and all that!

[austenr]

Here is a small snippet of my file. The divisions and amounts are in the same columns as the report. I stripped down everything else for privacy reasons. Thanks

[MrExcel]

When I stepped through the code, I noticed that the sum of revenue in P initially worked, but then was overwritten in the next line that added the Count function.

Try this code


Sub TryIt()
Dim IRange As Range
Dim ORange As Range
Dim FinalRow As Long, NextCol As Long, LastRow As Long
' Find the size of today's dataset
FinalRow = Cells(65536, 3).End(xlUp).Row
NextCol = Cells(1, 255).End(xlToLeft).Column + 2
' Set up output range. Copy heading from C1 there
Range("C1").Copy Destination:=Cells(1, NextCol)
Set ORange = Cells(1, NextCol)
' Define the Input Range
Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
' Do the Advanced Filter to get unique list of customers
IRange.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ORange, Unique:=True
'This will set up a new little summary off to the right of your data with just the unique divisions.
' Determine how many unique Divisions we have
LastRow = Cells(65536, NextCol).End(xlUp).Row
' Sort the data
Cells(1, NextCol).Resize(LastRow, 1).Sort _
Key1:=Cells(1, NextCol), Order1:=xlAscending, _
Header:=xlYes
' Add an array formula to get totals
Cells(1, NextCol + 1).Value = "Revenue"
Cells(2, NextCol + 1).FormulaArray = "=SUM((R2C3:R" & FinalRow & "C3=RC[-1])*R2C13:R" & FinalRow & "C13)"
Cells(1, NextCol + 2).Value = "Count"
Cells(2, NextCol + 2).FormulaR1C1 = _
"=COUNTIF(R2C3:R" & FinalRow & "C3,RC[-2])"
' Copy the formula
If LastRow > 2 Then
Cells(2, NextCol + 1).Resize(1, 2).Copy _
Cells(3, NextCol + 1).Resize(LastRow - 2, 2)
End If
End Sub