Vba code to calculate line items after sort

[Cosmo64]

Hi,

This is my first post, but have been a long time viewer and gather of information from this forum.

I currently have a report produced which gives me a list of customers, accounts , products, sales managers and the expiry date of that particular contract. This report produced over a three month date range can be up to 20,000 lines of data. Whilst the report itself is sufficient for sales managers, I want to be able to summarize the content of this report to a higher level.

One contract may have multiple lines of data due to multiple accounts etc so 100 line items on the report may indicate only one contract. I need to be able to summarize this data on another spreadsheet to show me numbers of contracts per sales team and expiry dates. So this would be a calculation based on column D,G and H. This will form the basis of a report giving an overview of what is outstanding.

Currently I have built a macro which sorts the original data and if the same product is attributed to the same customer but has a different account, the account is appended to the above cell and the below line is deleted. So 20,000 lines of data could reduce to about 8000. I need to then summarize those 8000 lines per sales team and expiry date. I was thinking of pivot tables but I would like to have it all done via a macro at the same time.
An example of my data is below and the code I am currently using

Sub appendcontracts()
Dim s, e As Long


ActiveSheet.Copy




'sort expiry date (7), cust number (3), product (4)"


Cells.Sort Key1:=Columns(7), key3:=Columns(4), Header:=xlYes, key2:=Columns(3)


s = 2
e = 2
While (Cells(e + 1, 3) <> "")

'If the customer number or product does not equal the cell above, append the account number up a cell
If Cells(e + 1, 3) <> Cells(e, 3) Or Cells(e + 1, 4) <> Cells(e, 4) Then
'changed, append account number to the first (s)
For i = s + 1 To e
If InStr(1, Cells(s, 1), Cells(i, 1)) = 0 Then
Cells(s, 1) = Cells(s, 1) & ", " & Cells(i, 1)
End If

Next i

'delete rows once account has been appended
For i = s + 1 To e
Rows(s + 1).Delete
Next i
s = s + 1

's = e + 1

e = s

Application.ScreenUpdating = False

Else
e = e + 1
End If

Wend


' this may be old code no longer required
If Cells(e + 1, 3) <> Cells(e, 3) Or Cells(e + 1, 4) <> Cells(e, 4) Then
'changed, append to the first (s)
For i = s + 1 To e
If InStr(1, Cells(s, 1), Cells(i, 1)) = 0 Then
Cells(s, 1) = Cells(s, 1) & ", " & Cells(i, 1)
End If

Next i

'delete rows
For i = s + 1 To e
Rows(s + 1).Delete
Next i
s = s + 1

's = e + 1

e = s
'Cells(s, 1).Activate
Application.ScreenUpdating = False

Else
e = e + 1
End If


End Sub

The spreadsheet after running this code looks like

[TABLE="class: cms_table, width: 764"]
<tbody>[TR]
[TD]Account[/TD]
[TD]contract nbr[/TD]
[TD]customer number[/TD]
[TD]Product[/TD]
[TD]Customer Name[/TD]
[TD]acct mgr[/TD]
[TD]expiry date[/TD]
[TD]Team[/TD]
[/TR]
[TR]
[TD="align: right"]99[/TD]
[TD="align: right"]401444[/TD]
[TD="align: right"]60125426[/TD]
[TD]Apples[/TD]
[TD]ACME[/TD]
[TD]Rep A[/TD]
[TD="align: right"]30/06/2015[/TD]
[TD]Yellow[/TD]
[/TR]
[TR]
[TD]1, 2, 3, 4[/TD]
[TD="align: right"]405641[/TD]
[TD="align: right"]60125426[/TD]
[TD]Oranges[/TD]
[TD]ACME[/TD]
[TD]Rep A[/TD]
[TD="align: right"]30/06/2015[/TD]
[TD]Yellow[/TD]
[/TR]
[TR]
[TD]35, 36[/TD]
[TD="align: right"]506456[/TD]
[TD="align: right"]60126958[/TD]
[TD]Pineapples[/TD]
[TD]TESTING CO[/TD]
[TD]Rep C[/TD]
[TD="align: right"]30/06/2015[/TD]
[TD]Red[/TD]
[/TR]
[TR]
[TD="align: right"]32[/TD]
[TD="align: right"]504564[/TD]
[TD="align: right"]60128584[/TD]
[TD]Apples[/TD]
[TD]ABCD[/TD]
[TD]Rep B[/TD]
[TD="align: right"]31/07/2015[/TD]
[TD]Blue[/TD]
[/TR]
[TR]
[TD="align: right"]33[/TD]
[TD="align: right"]504589[/TD]
[TD="align: right"]60128584[/TD]
[TD]Bananas[/TD]
[TD]ABCD[/TD]
[TD]Rep B[/TD]
[TD="align: right"]31/07/2015[/TD]
[TD]Blue[/TD]
[/TR]
[TR]
[TD="align: right"]24[/TD]
[TD="align: right"]505456[/TD]
[TD="align: right"]60123659[/TD]
[TD]Steel[/TD]
[TD]Brown Co[/TD]
[TD]Rep D[/TD]
[TD="align: right"]31/08/2015[/TD]
[TD]Green[/TD]
[/TR]
[TR]
[TD="align: right"]235615[/TD]
[TD="align: right"]251546[/TD]
[TD="align: right"]60123959[/TD]
[TD]Wood[/TD]
[TD]Brown Co[/TD]
[TD]Rep E[/TD]
[TD="align: right"]30/09/2015[/TD]
[TD]White[/TD]
[/TR]
[TR]
[TD]264615, 67[/TD]
[TD="align: right"]254617[/TD]
[TD="align: right"]60125874[/TD]
[TD]Plastic[/TD]
[TD]MYDE Pty Ltd[/TD]
[TD]Rep F[/TD]
[TD="align: right"]30/10/2015[/TD]
[TD]Black[/TD]
[/TR]
[TR]
[TD]154155, 154255[/TD]
[TD="align: right"]3012545[/TD]
[TD="align: right"]60125000[/TD]
[TD]Sand[/TD]
[TD]Work Co[/TD]
[TD]Rep G[/TD]
[TD="align: right"]30/11/2015[/TD]
[TD]Red[/TD]
[/TR]
[TR]
[TD="align: right"]51[/TD]
[TD="align: right"]3012588[/TD]
[TD="align: right"]60125000[/TD]
[TD]Wood[/TD]
[TD]Work Co[/TD]
[TD]Rep G[/TD]
[TD="align: right"]30/11/2015[/TD]
[TD]Red[/TD]
[/TR]
</tbody>[/TABLE]