AutoFilter Summary Macro

[Magoo]

To me this question sounds like a wish list macro but, I thought I
would give it a try anyway.
Here it goes;

I have a Spreadsheet with Autofiltering turned on. I would like to have
a macro that goes through a specified column's filter and give me a
subtotal summary of the various things found in the filter based off of
another column that has corresponding amounts in it.
Please see the example below.

Title 1 Amount Title 3 Title 4
101 3 101 Unique Data1
102 1 102 Unique Data1
103 5 103 Unique Data1
104 8 104 Unique Data2
105 2 105 Unique Data3
106 4 106 Unique Data4
107 6 107 Unique Data5
108 4 108 Unique Data3
109 2 109 Unique Data3

I would like the macro to create a temporary summary sheet (for
printing purposes) that does this.
Unique Data1 totaled 9
Unique Data2 totaled 8
And so on.
I would like all of the summary to appear on one sheet if possible.

 

[bpeltzer]

Check out the DSUM and DCOUNT functions. They'll allow you to get your
totals by group, refreshed automatically, without having to cycle through
each of the filters. If you know that each set of criteria is unique, then
I'd set up something like:
Criteria1 Criteria2 Result
value1.1 value2.1 =DSUM(database, field, A$1:B2)
value1.2 value2.2 =DSUM(database, field, A$1:B3)-sum(c$2:c2).
Then autofill that second formula down.

 

[Tom Ogilvy]

You can put a unique list of items on another sheet with Advanced filter.

Assume you place them starting in A2 and your original sheet is named data
with you table starting in A1

You can get you sums with

=Sumif(Data!D,A2,Data!B:B)

in B2 and then copied down.

code would be

Sub ABCD()
Dim rng As Range

With Worksheets("Data")
If .FilterMode Then
.ShowAllData
End If
.Range("A1").CurrentRegion.Columns(4).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Summary").Range("A1"), _
Unique:=True
End With
With Worksheets("Summary")
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With
rng.Offset(0, 1).Formula = "=Sumif(Data!D,A2,Data!B:B)"
End Sub

 

[Magoo]

Thanks I will try the suggestions.