Monthly Report

[Christien]

Dear Freinds
I am new to this world but i hope that i could get some help
I Have data listed in sheet called Data as follows:
DateSales ItemSold Dtl1 Dtl2 Dtl3 T-Price Quantity
01.01.2010 Item1 60 6
01.01.2010 Item2 80 4
01.01.2010 Item3 90 2
02.01.2010 Item4 100 50
02.01.2010 Item5 150 6
09.01.2010 Item6 70 2
09.01.2010 Item7 25 5
01.02.2010 Item8 50 2
01.02.2010 Item9 130 3

etc.....

where itemSold can not be a duplicate
i would like to produce a monthy report based on criteria entered in a cell
in Sheet Called Report (Same Workbook)
that should look like this
ItemSold DateSales Dtl1 Dtl2 Dtl3 T-Price Quantity
Item1 01.01.2010 60 6
Item2 01.01.2010 80 4
Item3 01.01.2010 90 2
01.01.2010 Total 230 12
Item4 02.01.2010 100 50
Item5 02.01.2010 150 6
02.01.2010 Total 250 56
Item6 09.01.2010 70 2
Item7 09.01.2010 25 5
09.01.2010 Total 95 7

Gtotal Per Month 575 75

 

[Don Guillett]

It need not be that hard.
Select your range>data>subtotals>>>>>>clear all when through

 

[Christien]

Thank Yu Don appreciate your help, But can we do such a task
Programmatically...?

 

[Don Guillett]

Sure. Just record it and clean it up. Do another to clear the subtotals. If
all else fails,
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[Christien]

Mr.Don
All my attempts are not succesful
i send you an e-Mail as u told me before
hope you can help

have a nice weekend
and many thanks

 

[Don Guillett]

For the archives

Sub GetSubtotalsSAS()
Dim lr As Long
Dim lc As Long
Dim c As Range
Dim firstaddress
'Get Subtotals
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(8, Columns.Count).End(xlToLeft).Column
Range("a8").Resize(lr - 7, lc).Subtotal GroupBy:=3, Function:=xlSum, _
TotalList:=Array(12, 13), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True

'color rows
With Columns(3)
Set c = .Find(What:="Total", After:=Cells(8, "c"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Cells(c.Row, 1).Resize(, 14).Interior.ColorIndex = 15
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
'print preview
ActiveSheet.PrintPreview

End Sub
Sub RemoveSubtotalSAS()
With ActiveSheet.Cells
.RemoveSubtotal
.Interior.ColorIndex = xlNone
End With
End Sub