You are here:

Excel/Subtotals with VBA or Manual Process


Hi Tom,

I'm hoping you can with a formula that can automatically enter sub-totals in a column when certain conditions are met. Here's the context:

I'm reporting on the sales performance of approximately 300 stores collectively owned by about 30 franchises. I have a worksheet which includes a list of each store in column A with its franchise listed beside it in column B. It's sorted alphabetically by franchise, then by store, so that you the stores are clustered by franchise. This way it's easy to see that franchise A owns 6 stores, then franchise B owns 10 stores etc ...

In a separate worksheet (or at least somewhere else on the same one) I'm hoping to do the following:

List the 6 stores in franchise A in a column, then insert the franchise name in a 7th row of the same column, before moving on to the next franchise's stores. Essentially, I need to detect whenever the last store in a franchise is listed and insert the franchise name. This way I can use index/match functions to place store performance data next to the store names, and their sub totals next to the franchise name. I know it can be done manually with the sub-total function but I'm hoping to avoid this so the report can run automatically.

Any suggestions will be greatly appreciated.

With thanks,



I am assuming you want a macro because doing it with formulas would probably take a lot longer than the built in subtotal function.  

Assume your data is in a sheet named "Data" with the first store in A2
Assume your output goes to a sheet named report starting in A2
Assume that there is no data below the last store listed in sheet Data (column A)

This code worked as I understood your requirement and the assumptions I stated.  Adjust to fit your actual situation.

Sub abc()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r As Range
Dim cell As Range
Dim rw2 As Long
 rw2 = 2
 Set sh1 = Worksheets("Data")
 Set sh2 = Worksheets("Report")
 Set r = sh1.Range("A2", sh1.Cells(sh1.Rows.Count, 1).End(xlUp))
 For Each cell In r
   sh2.Cells(rw2, "A").Value = cell.Value  ' write store name
   rw2 = rw2 + 1
   ' check if this is last store in franchise
   If cell.Offset(0, 1).Value <> cell.Offset(1, 1).Value Then
     ' write franchise name
    sh2.Cells(rw2, "A").Value = cell.Offset(0, 1).Value
    rw2 = rw2 + 1
   End If
End Sub

Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2017 All rights reserved.