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