Search code examples
vbaexceldistinct-values

Excel VBA: Output Distinct Values and Subtotals


I have data of this form:

Category      Source      Amount
Dues          FTW         $100
Donations     ODP         $20
Donations     IOI         $33
Dues          MMK         $124

There is no sort order. The categories are unknown at compile time. I want a VBA macro to cycle through the range, output a list of distinct values, with the subtotals for each. For the above data, it would look like this:

Category      Total Amount
Dues          $224
Donations     $55

How can I do this? Also, is there a way to make the macro run every time the table above is updated, or is it necessary for the user to click a button?


Solution

  • You may want to use a built in Excel feature to do this. Looping can take a long time and be problematic if you have a lot of values to loop through.

    Something like the following might get you started on creating a pivot table (from http://www.ozgrid.com/News/pivot-tables.htm)

    Sub MakeTable()
    Dim Pt As PivotTable
    Dim strField As String
    
        'Pass heading to a String variable
        strField = Selection.Cells(1, 1).Text
    
        'Name the list range
        Range(Selection, Selection.End(xlDown)).Name = "Items"
    
        'Create the Pivot Table based off our named list range.
        'TableDestination:="" will force it onto a new sheet
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
            SourceData:="=Items").CreatePivotTable TableDestination:="", _
                TableName:="ItemList"
    
        'Set a Pivot Table variable to our new Pivot Table
        Set Pt = ActiveSheet.PivotTables("ItemList")
    
        'Place the Pivot Table to Start from A3 on the new sheet
        ActiveSheet.PivotTableWizard TableDestination:=Cells(3, 1)
    
        'Move the list heading to the Row Field
        Pt.AddFields RowFields:=strField
        'Move the list heading to the Data Field
        Pt.PivotFields(strField).Orientation = xlDataField
    End Sub
    

    This is for subtotals (though I much prefer pivot tables) http://msdn.microsoft.com/en-us/library/aa213577(office.11).aspx


    EDIT: I reread and have the following thoughts. Set up the pivot table on a separate sheet (without using any code) then put the following code on the sheet that has the pivot table so that the table will update everytime the sheet is selected.

        Private Sub Worksheet_Activate()
    
        Dim pt As PivotTable
    
            'change "MiPivot" to the name of your pivot table
            Set pt = ActiveSheet.PivotTables("MyPivot")
    
            pt.RefreshTable
    
        End Sub
    

    Edit #2 Refresh all pivot tables on sheet http://www.ozgrid.com/VBA/pivot-table-refresh.htm

    Private Sub Worksheet_Activate()    
        Dim pt As PivotTable
    
        For Each pt In ActiveSheet.PivotTables
            pt.RefreshTable
        Next pt
    End Sub
    

    The link has multiple options on how to refresh pivot tables in the sheet/workbook.