Oops.., forgot to include Sort...

Sub GetSummaryInfo()
' Creates a unique list of names starting in B2
' of the summary area.

Dim n&, k&, lRow&, sList$
Dim rngData As Range, rngSummary As Range
Const sSortField$ = "D2:D24" '//subtotal col

'Initialize vars
Set rngData = ActiveSheet.UsedRange
Set rngSummary = rngData.Range("B2:D24")
lRow = Cells(Rows.Count, 1).End(xlUp).Row
k = 1 '//header row

rngSummary.ClearContents
For n = 25 To lRow
If Not InStr(sList, rngData.Cells(n, 1)) 0 Then
'Add name to sList and increment counter 1 row
sList = sList & "," & rngData.Cells(n, 1): k = k + 1
With rngData.Cells(k, 2)
.Value = rngData.Cells(n, 1)
.Offset(0, 2).Formula = "=SUMIF(Categories,Category,Sales)"
End With
End If
Next 'n

SortData sSortField, rngSummary.Address, xlDescending
End Sub

Sub SortData(sKey$, sSetRng$, lOrder, Optional Wks As Worksheet)

If Wks Is Nothing Then Set Wks = ActiveSheet
With Wks.Sort
.SortFields.Clear
.SortFields.Add Key:=Range(sKey), _
SortOn:=xlSortOnValues, Order:=lOrder, _
DataOption:=xlSortNormal
.SetRange Range(sSetRng): .Header = xlNo
.MatchCase = False: .Orientation = xlTopToBottom
.SortMethod = xlPinYin: .Apply
End With 'Wks.Sort
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion