• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 486
  • Last Modified:

Add header fields to an excel spreadsheet that is created using code

Hi, I have an Access module that parses data and creates individual spreadsheets.  I'd like to add on the first 4 rows of the Excel spreadsheets some header information (i.e. company name and report name on row 1, the specific agents name on row 2, the month and date of the report on row 3 and "Company Confidential" on row 4.  Then I'd like the individual parsed records (and column headings) to begin on row 5.  I've included the module code below.  Thanks in advance for your help.

Option Compare Database

Sub exp2XL2()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object

Set rsDir = CurrentDb.OpenRecordset("select distinct AgentName from tblAgentCommissionReportOutput")

If rsDir.EOF Then Exit Sub
rsDir.MoveFirst

Do Until rsDir.EOF
Set xlObj = CreateObject("Excel.Application")
xlObj.Workbooks.Add

ssql = "SELECT [tblAgentCommissionReportOutput].AgentName, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentTerritory, "
ssql = ssql & " [tblAgentCommissionReportOutput].strAcctMgrLogin, "
ssql = ssql & " [tblAgentCommissionReportOutput].CustomerTerritory, "
ssql = ssql & " [tblAgentCommissionReportOutput].dtClientStartDate AS StartDate, "
ssql = ssql & " [tblAgentCommissionReportOutput].tDate AS TransDate, "
ssql = ssql & " [tblAgentCommissionReportOutput].[Description], "
ssql = ssql & " [tblAgentCommissionReportOutput].TransAmount, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentComm, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentPay, "
ssql = ssql & " [tblAgentCommissionReportOutput].FranchiseeName"
ssql = ssql & " FROM [tblAgentCommissionReportOutput]"
ssql = ssql & " Where AgentName='" & rsDir("AgentName") & "'"

Set rs = CurrentDb.OpenRecordset(ssql, dbOpenDynaset)

Set Sheet = xlObj.activeworkbook.Sheets("sheet1")

'rename the sheet, you can use any of the recordset field
Sheet.Name = rsDir("AgentName")

'copy the headers
For iCol = 0 To rs.Fields.Count - 1
Sheet.cells(1, iCol + 1).Value = rs.Fields(iCol).Name
Next

Sheet.Range("A2").CopyFromRecordset rs 'copy the data

xlObj.activeworkbook.SaveAs "C:\Documents and Settings\All Users\Desktop\" & rsDir("AgentName") & ".xls", FileFormat:=-4143
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Sub
0
divehunter
Asked:
divehunter
  • 6
  • 5
1 Solution
 
divehunterAuthor Commented:
I just realized there is another related item I need help with.  In the spreadsheets the code creates there are 2 columns.  One column is amount and the other is commission amount.  Because each agent will have a different number of records (rows) in their specific spreadsheet, is there a way in the code to specify to sum the 2 columns at the bottom of the spreadsheet?  As an example, record one might be for John Smith with an Amount of $100 and a commission amount of $20, record two (also for John) might show a record with an amount of $50 and a commission amount of $10.  I'd like to have a sum total at the bottom of each of these columns (i.e. total amount $150, total commission amount $30).  Thanks again and please let me know if you need additional information.  
0
 
divehunterAuthor Commented:
This is the last item to finish this project so I thought I'd add some more points in the hope someone can help.  Thanks in advance.
0
 
Patrick MatthewsCommented:
Hello divehunter,

1) It's difficult to read VBA code that is not indented properly.  I think you may get more Expert involvement
if you'd indent.

2) Please post a mockup of what the final Excel output should look like.  Fake the data if need be to protect
sensitive information.

Regards,

Patrick
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
Rey Obrero (Capricorn1)Commented:

better if you can attach a db with table tblAgentCommissionReportOutput
and an example of the output excel file
0
 
divehunterAuthor Commented:
Hi, Thanks for the response.  I've attached 1 workbook (3 worksheets).  One is called sample and it shows what the current output spreadsheet looks like for each individual agent.  The second spreadsheet (desired) is what I'd like to get it to look like.  If it's a lot of work to bold the header fields and center them, don't worry about it.  The 3rd is an excel (trunc) version of the tblAgentCommissionReportOutput.  Hope this helps. Sorry about not indenting.  Still learning the ropes.  I'll make sure I indent in the future.  Thanks for the heads up and for all of your help.  
projectsample.xls
0
 
Rey Obrero (Capricorn1)Commented:
where is the db with the table
0
 
Rey Obrero (Capricorn1)Commented:


Sub exp2XL2()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object

Set rsDir = CurrentDb.OpenRecordset("select distinct AgentName from tblAgentCommissionReportOutput where AgentName='All Mountain Technologies'")

If rsDir.EOF Then Exit Sub
rsDir.MoveFirst

Do Until rsDir.EOF
Set xlObj = CreateObject("Excel.Application")
xlObj.Workbooks.Add
'Stop
ssql = "SELECT [tblAgentCommissionReportOutput].AgentName, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentTerritory, "
ssql = ssql & " [tblAgentCommissionReportOutput].strAcctMgrLogin, "
ssql = ssql & " [tblAgentCommissionReportOutput].CustomerTerritory, "
ssql = ssql & " [tblAgentCommissionReportOutput].dtClientStartDate AS StartDate, "
ssql = ssql & " [tblAgentCommissionReportOutput].tDate AS TransDate, "
ssql = ssql & " [tblAgentCommissionReportOutput].[Description], "
ssql = ssql & " [tblAgentCommissionReportOutput].TransAmount, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentComm, "
ssql = ssql & " [tblAgentCommissionReportOutput].AgentPay, "
ssql = ssql & " [tblAgentCommissionReportOutput].FranchiseeName"
ssql = ssql & " FROM [tblAgentCommissionReportOutput]"
ssql = ssql & " Where AgentName='" & rsDir("AgentName") & "'"

Set rs = CurrentDb.OpenRecordset(ssql, dbOpenDynaset)

Set Sheet = xlObj.activeworkbook.Sheets("sheet1")

'rename the sheet, you can use any of the recordset field
Sheet.Name = rsDir("AgentName")

'copy the headers
For iCol = 0 To rs.Fields.Count - 1
Sheet.cells(5, iCol + 1).Value = rs.Fields(iCol).Name
Next

Sheet.range("A6").CopyFromRecordset rs 'copy the data

Dim rowCnt, colCnt
Sheet.cells(1, 1).Value = "DataPreserve Agent Commission Report"
Sheet.cells(2, 1).Value = Format(Date, "mmm - yyyy")
Sheet.cells(3, 1).Value = rsDir("AgentName")
Sheet.cells(4, 1).Value = "Confidential"

rowCnt = Sheet.usedrange.rows.Count
colCnt = Sheet.usedrange.Columns.Count

xlObj.range("A1:" & Chr(64 + colCnt) & 1).merge
xlObj.range("A2:" & Chr(64 + colCnt) & 2).merge
xlObj.range("A3:" & Chr(64 + colCnt) & 3).merge
xlObj.range("A4:" & Chr(64 + colCnt) & 4).merge
xlObj.range("A1:" & Chr(64 + colCnt) & 4).Font.Bold = True
xlObj.range("A1:" & Chr(64 + colCnt) & 4).HorizontalAlignment = -4108


xlObj.range("A5:" & Chr(64 + colCnt) & 5).Font.Bold = True
xlObj.range("A5:" & Chr(64 + colCnt) & rowCnt).Columns.AutoFit

xlObj.range("H" & rowCnt + 1).formula = "=Sum(" & "H6:H" & rowCnt & ")"
xlObj.range("J" & rowCnt + 1).formula = "=Sum(" & "J6:J" & rowCnt & ")"


xlObj.range("A" & rowCnt + 1).Value = "Total"
xlObj.range("A" & rowCnt + 1).entirerow.Font.Bold = True

xlObj.activeworkbook.SaveAs "C:\Documents and Settings\All Users\Desktop\" & rsDir("AgentName") & ".xls", FileFormat:=-4143
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Sub
0
 
divehunterAuthor Commented:
I have to Capricorn1 that it's obvious why you're #1.  Everytime you help me I'm amazed by your knowledge.  Thank you so much for all your help.  This worked perfectly.  I had to change the 'AllMountainTechnologies' back to AgentName but it couldn't work any better.
0
 
divehunterAuthor Commented:
PS - My boss asked me to let me know if you do any side contract work, we would be very interested in talking to you about some development work we need done.  Thanks again.
0
 
Rey Obrero (Capricorn1)Commented:
look in my profile. send me a note.
0
 
divehunterAuthor Commented:
Thanks.  I've forwarded your email address to my boss.  He should be contacting you soon.  His name is Carl Landis.  Thanks again for all the help.
0
 
Rey Obrero (Capricorn1)Commented:
u r welcome!!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now