Dear all,

I have a piece of codes that used to convert live data to a report
format, it work fine while the data is small but when I feed more data
said 3000 records it will take around 4-5 mins and sometime hang !
My PC is PIII 700.

I do appreciate that someone can teach me how to improve the current
coding.

Thanks
Dolphin

Sample format

User product date Qty
a xx 1/1/00 10
b xy 1/2/02 2
c xz 1/2/01 5
a xx 1/10/00 1

after convert in a new worksheet


User product 1/00 2/00 ....1/01.......1/02.......12/02
a xx 11
b xy 2
c xz 5


Coding

Sub summary()

Application.ScreenUpdating = False
Application.EnableEvents = False
Dim r As Range, c As Range
ThisWorkbook.Sheets("summary").Cells.ClearContents

With ThisWorkbook.Sheets("Data")
Set r = Range(.Range("A2"), _
..Range("A" & Rows.Count).End(xlUp))
ThisWorkbook.Names.Add Name:="Customer", RefersTo:=r
ThisWorkbook.Names.Add Name:="Item_no", RefersTo:=r.Offset(0, 1)
ThisWorkbook.Names.Add Name:="dates", RefersTo:=r.Offset(0, 1)
ThisWorkbook.Names.Add Name:="amounts", RefersTo:=r.Offset(0, 2)

..Columns("A").AdvancedFilter Action:=xlFilterCopy, _
unique:=True, copytorange:=Sheets("Summary").Range("A1:a1")
End With

With ThisWorkbook.Sheets("Summary")
..Rows("1:1").NumberFormat = "dd mmm yyyy"
..Range("b1").FormulaR1C1 = _
"=date(year(min(Data!c)),1+month(min(Data!c)),day( 0))"
..Range("c1:z1").FormulaR1C1 = _
"=date(year(rc[-1]),2+month(rc[-1]),day(0))"

Set r = .Range("c1:z1")
For Each c In r
If c - 32 Application.Max(Sheets("Data").Range("dates")) Then
c.ClearContents

ElseIf c.Offset(0, -1) = "" Then c.ClearContents
End If


Next c
Set r = .Range(.Range("a2"), .Range("a" & _
Rows.Count).End(xlUp)).Offset(0, 1)

Application.Calculation = xlManual
Application.ScreenUpdating = False

r.FormulaR1C1 = _
"=sumproduct((Summary!r1c=dates)*(Customer=Summar y!rc1)*(amounts))"
Set r = .Range(.Range("b1"),
..Range("iv1").End(xlToLeft).Offset(Application.Co untA(.Range("a:a")) -
2, 0)).Offset(1, 0)
r.FormulaR1C1 = _
"=sumproduct((Summary!r1c=dates)*(customer=Summar y!rc1)*(amounts))-sum(Summary!rc3:rc[-1])"
..Rows("1.1").Font.Bold = True
..Columns("A:a").Font.Bold = True
..Cells.Columns.AutoFit
End With

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.EnableEvents = True


End Sub