Solved

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

Posted on 2008-06-20
12
360 Views
Last Modified: 2013-11-27
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
Comment
Question by:divehunter
  • 6
  • 5
12 Comments
 

Author Comment

by:divehunter
ID: 21834388
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
 

Author Comment

by:divehunter
ID: 21835168
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
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 21835366
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
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 21835376

better if you can attach a db with table tblAgentCommissionReportOutput
and an example of the output excel file
0
 

Author Comment

by:divehunter
ID: 21835719
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
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 21835726
where is the db with the table
0
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 21836084


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
 

Author Closing Comment

by:divehunter
ID: 31469306
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
 

Author Comment

by:divehunter
ID: 21848645
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
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 21848681
look in my profile. send me a note.
0
 

Author Comment

by:divehunter
ID: 21849880
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
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 21849965
u r welcome!!!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

932 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now