Skjoldborg
New Member
- Joined
- Feb 16, 2009
- Messages
- 7
Hello VBA Expers 
Six months ago I startet looking into VBA, and this forum basically taught me all I know of VBA
I have always been able to find answers here.. However here is my first post on a problem I can’t solve on my own or seem to read the answer to.
Here is the case:
I am extracting data from a excel file and then I am arranging the data in my own excel file. My own excel file contains “contracts” - each line in this sheet contains a contract. Within the line I have all the information needed. I want to create several reports with contracts - they have to be split depending on who owns the contract. The contract owner is defined within each line of the data. The “contract owner” can have multiple contracts so I need to sort the reports so that each "contract owner" only gets 1 email with and attachment with 1 excel file with all his contracts.
So basically I want to split my excel file into several reports depending on a certain criteria (cell value = contract owner).
And… I basically created a code that does all this for me.. however I need to tweak the code.
This is important, as you can see in my code, it is long and depending on the names within the VBA code are correct.
(Right now i have 46 owners and 250 contracts, so i would have to doublicate the code below 46 times!!).
Further I am possiblely not the one to maintain the VBA code - so when contract owners change (promted/hired/fired) the code needs to be update manually.. which is a huge pitfall. (or impossible with the code in its current form).
This is were you come in! There are so many experts out there, I am sure one of you can crack this case – and enlighten me
Hope to see some inputs - thank you in advace. Peace out!
(Before you suggest I put this into Access I have to add that I know nothing of Access and my department insists to keep our database as an excel-sheet until a proper contract management system is in place)
//Skjoldborg
VBA student
Six months ago I startet looking into VBA, and this forum basically taught me all I know of VBA
I have always been able to find answers here.. However here is my first post on a problem I can’t solve on my own or seem to read the answer to.
Here is the case:
I am extracting data from a excel file and then I am arranging the data in my own excel file. My own excel file contains “contracts” - each line in this sheet contains a contract. Within the line I have all the information needed. I want to create several reports with contracts - they have to be split depending on who owns the contract. The contract owner is defined within each line of the data. The “contract owner” can have multiple contracts so I need to sort the reports so that each "contract owner" only gets 1 email with and attachment with 1 excel file with all his contracts.
So basically I want to split my excel file into several reports depending on a certain criteria (cell value = contract owner).
And… I basically created a code that does all this for me.. however I need to tweak the code.
This is important, as you can see in my code, it is long and depending on the names within the VBA code are correct.
(Right now i have 46 owners and 250 contracts, so i would have to doublicate the code below 46 times!!).
Further I am possiblely not the one to maintain the VBA code - so when contract owners change (promted/hired/fired) the code needs to be update manually.. which is a huge pitfall. (or impossible with the code in its current form).
This is were you come in! There are so many experts out there, I am sure one of you can crack this case – and enlighten me
Code:
Sub splitnsend()
'Here i select the first contract owner
Selection.AutoFilter Field:=14, Criteria1:="Bill Gates"
Columns("A:O").Select
Selection.Copy
'creating a new workbook that will serve as report (later to be emailed to bill)
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
'following code is the report on Bills active contracts
'' THE FOLLOWING IS CREATING THE REPORT
Range("A1").Select
RowCount = ActiveCell.CurrentRegion.Rows.Count
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(2, 0).FormulaR1C1 = "Total Contract Value (SEK)"
ActiveCell.Offset(3, 0).FormulaR1C1 = "Total Commitment (SEK)"
ActiveCell.Offset(2, 1).FormulaR1C1 = "=SUM(OFFSET(R1C3,0,0,COUNTA(C3),1))"
ActiveCell.Offset(3, 1).FormulaR1C1 = "=SUM(OFFSET(R1C4,0,0,COUNTA(C4),1))"
ActiveCell.Offset(3, 1).Select
ActiveCell.CurrentRegion.Select
Selection.Style = "Comma"
Selection.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
Selection.Font.Bold = True
Range("A1").Select
''REPORT DONE - TIME TO EMAIL:
Range("O2").Select 'selecting range for emailaddress
'Defining stuff for email
Dim OutlookApp As Object
Dim MItem As Object
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim rCell As Range
Dim EmailStr As String
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
'Create list of emails from selected cells
'THIS is a code is what i use to define my "to" (this case bill)
'I KNOW this is not what the code originally intended to do.. it was
'designed to create a list of emailaddresses (from a selected range)
For Each rCell In Selection.Cells
EmailStr = EmailStr + rCell & ";"
Next rCell
'save attachment
'I need to save the workbook i am gonna report in order to give it the name i want
ActiveWorkbook.SaveAs Filename:= _
Environ$("temp") & "\" & ActiveWorkbook.ActiveSheet.Range("N2").Value & "'s" & " " & "Consultant Report" & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
email_ = EmailStr
subject_ = "Consultant Contract Report"
body_ = "Hello, Attached you find a report of your currently active contracts"
'Create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Attachments.Add ActiveWorkbook.FullName
.Body = body_
.Display
End With
ActiveWorkbook.Close
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Windows("Split and send.xls").Activate
Sheets("Sheet1").Select
Selection.AutoFilter Field:=14
'**** NEW OWNER****
' THEN I START ALL OVER WITH STEVE's CONTRACTS
' I HAVE 46 contract owners in my orignial datas
' I really hope there is a better way - or it is gonna be
' a long a vounaruble code
Selection.AutoFilter Field:=14, Criteria1:="Steve Jobs"
Columns("A:O").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
RowCount = ActiveCell.CurrentRegion.Rows.Count
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(2, 0).FormulaR1C1 = "Total Contract Value (SEK)"
ActiveCell.Offset(3, 0).FormulaR1C1 = "Total Commitment (SEK)"
ActiveCell.Offset(2, 1).FormulaR1C1 = "=SUM(OFFSET(R1C3,0,0,COUNTA(C3),1))"
ActiveCell.Offset(3, 1).FormulaR1C1 = "=SUM(OFFSET(R1C4,0,0,COUNTA(C4),1))"
ActiveCell.Offset(3, 1).Select
ActiveCell.CurrentRegion.Select
Selection.Style = "Comma"
Selection.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
Selection.Font.Bold = True
Range("A1").Select
Range("O2").Select
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
'Create list of emails from selected cells
For Each rCell In Selection.Cells
EmailStr = EmailStr + rCell & ";"
Next rCell
'save attachment
ActiveWorkbook.SaveAs Filename:= _
Environ$("temp") & "\" & ActiveWorkbook.ActiveSheet.Range("N2").Value & "'s" & " " & "Consultant Report" & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
email_ = EmailStr
subject_ = "Consultant Contract Report"
body_ = "Hello, Attached you find a report of your currently active contracts"
'Create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Attachments.Add ActiveWorkbook.FullName
.Body = body_
.Display
End With
ActiveWorkbook.Close
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Windows("Split and send.xls").Activate
Sheets("Sheet1").Select
Selection.AutoFilter Field:=14
'**** NEW OWNER****
' STARTING OVER AGAIN *SIGH* :)
'Selection.AutoFilter Field:=14, Criteria1:="Steve Jobs"
'.............
'.......
'....
'...Hope to see some inputs - thank you in advace. Peace out!
(Before you suggest I put this into Access I have to add that I know nothing of Access and my department insists to keep our database as an excel-sheet until a proper contract management system is in place)
//Skjoldborg
VBA student
