?
Solved

Format an Excel Spreadsheet from Access

Posted on 2005-04-18
5
Medium Priority
?
921 Views
Last Modified: 2009-08-20
In Access, I have a form with a command button that transfers an entire table's data into an Excel spreadsheet. The code I'm using for that is:

DoCmd.TransferSpreadsheet acExport, acspreadsheetTypeExcel19, "tblData", "c:\tblData.xls"

The spreadsheet looks something like this after the transfer:

Employee      Category1     Category2
Dave                 100             40
Dave                   50             30
Dave                   25            100
Steve                  50            200
Steve                 200             65
Steve                  80              90

I'd like the spreadsheet to automatically appear like this after the transfer:

(the following to appear on Sheet1 or File1 --- whichever is easier)
Employee: Dave
 
  Category1     Category2
         100             40
           50             30
           25            100

Total: 175            170

(the following to appear on Sheet2 or File2 --- whichever is easier)
Employee: Steve
 
   Category1     Category2
           50            200
          200             65
           80              90

Total:  330          355

As you may be able to tell by looking at the example data above, I'm looking to have a "Total" line inserted below the data which will total the data in each of the columns.  I'm also looking to eliminate the first column since it contains repetitive Employee name data. Instead, I'd like to have the Employee name appear just one time above the header line. Finally, I'd like to have each employee's data appear on a seperate sheet ( or seperate file entirely... whichever is easier).   Thanks for your anticipated help,


0
Comment
Question by:dbfromnewjersey
  • 2
  • 2
5 Comments
 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 1000 total points
ID: 13809803
Hi [again :)],

With reference to the previous question, [ http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21392819.html ]...

Please create a new global/public module in MS-Access & paste the following code within it:

Option Compare Database
Option Explicit
Public Sub Export_to_Excel()

  Dim lngRow                                            As Long
  Dim objExcel_Application                              As Object
  Dim objSheet                                          As Object
  Dim objTable                                          As Object
  Dim strLast_Employee                                  As String
 
  Set objExcel_Application = CreateObject("Excel.Application")
 
' objExcel_Application.Visible = True                 ' Un-comment to monitor progress
 
  Set objTable = CurrentDb.OpenRecordset("SELECT [Employee], [Category1], [Category2] FROM [tblData] ORDER BY [Employee]")
 
  objTable.MoveLast
  objTable.MoveFirst
 
  lngRow = 1&
  strLast_Employee = vbNullChar
  objExcel_Application.Workbooks.Add
 
  Set objSheet = objExcel_Application.ActiveSheet
 
  While Not (objTable.EOF)
 
      If objTable.Fields("Employee") <> strLast_Employee Then
         If strLast_Employee <> vbNullChar Then
            objExcel_Application.ActiveSheet.Cells(lngRow + 2&, 1) = "Total: " & CStr(objExcel_Application.WorksheetFunction.Sum(objExcel_Application.ActiveSheet.Range("A4:" & objExcel_Application.ActiveSheet.Cells(lngRow, 1).Address)))
            objExcel_Application.ActiveSheet.Cells(lngRow + 2&, 2) = objExcel_Application.WorksheetFunction.Sum(objExcel_Application.ActiveSheet.Range("B4:" & objExcel_Application.ActiveSheet.Cells(lngRow, 2).Address))
         End If
         
         objExcel_Application.Worksheets.Add objExcel_Application.Worksheets(objExcel_Application.Worksheets.Count)
         objExcel_Application.ActiveSheet.Name = objTable.Fields("Employee")
         objExcel_Application.ActiveSheet.Range("A1") = "Employee: " & objTable.Fields("Employee")
         objExcel_Application.ActiveSheet.Range("A3") = "Category1"
         objExcel_Application.ActiveSheet.Range("B3") = "Category2"
         lngRow = 3&
      End If
     
      lngRow = lngRow + 1&
     
      objExcel_Application.ActiveSheet.Cells(lngRow, 1) = objTable.Fields("Category1")
      objExcel_Application.ActiveSheet.Cells(lngRow, 2) = objTable.Fields("Category2")
     
      strLast_Employee = objTable.Fields("Employee")
     
      objTable.MoveNext
     
  Wend
 
  If strLast_Employee <> vbNullChar Then
     objExcel_Application.ActiveSheet.Cells(lngRow + 2&, 1) = "Total: " & CStr(objExcel_Application.WorksheetFunction.Sum(objExcel_Application.ActiveSheet.Range("A4:" & objExcel_Application.ActiveSheet.Cells(lngRow, 1).Address)))
     objExcel_Application.ActiveSheet.Cells(lngRow + 2&, 2) = objExcel_Application.WorksheetFunction.Sum(objExcel_Application.ActiveSheet.Range("B4:" & objExcel_Application.ActiveSheet.Cells(lngRow, 2).Address))
  End If
 
  objExcel_Application.Worksheets(objSheet.Name).Delete
 
  objExcel_Application.Worksheets(1).Activate
 
  objExcel_Application.Activeworkbook.Close True, "c:\output.xls"
  objExcel_Application.Quit
 
  objTable.Close
 
  Set objSheet = Nothing
  Set objTable = Nothing
  Set objExcel_Application = Nothing
 
End Sub


Note: Replace the line...
  Set objTable = CurrentDb.OpenRecordset("SELECT [Employee], [Category1], [Category2] FROM [tblData] ORDER BY [Employee]")

With the SQL statement you need to return an (ascending) ordered list of Employees, with their corresponding Category1 & Category2 fields.


Then, run the "Export_to_Excel()" subroutine to create a file "c:\output.xls" as desired.
(Obviously change the line with this filename specified if you wish to create a different file)

BFN,

fp.
0
 
LVL 2

Expert Comment

by:andymcooper
ID: 13810085
Try:

Option Compare Database
Option Explicit

Public Sub CopyToOtherSheets()

    Dim wb As Workbook
    Dim ssData As Worksheet
    Dim ssNew As Worksheet
    Dim lRow As Long
    Dim lNewRow As Long
    Dim lCat1 As Long
    Dim lCat2 As Long
    Dim lCat1Tot As Long
    Dim lCat2Tot As Long
    Dim strName As String
    Dim strNewName As String
    Dim AppExcel As New Excel.Application
   
    Set AppExcel = New Excel.Application
    AppExcel.Visible = True
   
    Set wb = AppExcel.Workbooks.Open("H:\Book1.xls")
    Set ssData = wb.Sheets("Sheet1")
   
    lRow = 2
    strNewName = "temp"
    Do Until strNewName = ""
        'find out next name
        strName = ssData.Cells(lRow, 1)
       
        'add a new sheet with the name
        Set ssNew = wb.Sheets.Add
        ssNew.Name = strName
        ssNew.Cells(1, 1) = strName
        ssNew.Cells(3, 1) = "Category1"
        ssNew.Cells(3, 2) = "Category2"
       
        'now copy the data
        lNewRow = 4
        lCat1Tot = 0
        lCat2Tot = 0
        strNewName = strName
        Do Until Not strNewName = strName
            lCat1 = ssData.Cells(lRow, 2)
            lCat2 = ssData.Cells(lRow, 3)
            lCat1Tot = lCat1Tot + lCat1
            lCat2Tot = lCat2Tot + lCat2
            ssNew.Cells(lNewRow, 1) = lCat1
            ssNew.Cells(lNewRow, 2) = lCat2
            lNewRow = lNewRow + 1
            lRow = lRow + 1
            strNewName = ssData.Cells(lRow, 1)
        Loop
       
        'add totals
        ssNew.Cells(lNewRow + 1, 1) = "Totals:"
        ssNew.Cells(lNewRow + 2, 1) = lCat1Tot
        ssNew.Cells(lNewRow + 2, 2) = lCat2Tot
    Loop
   
End Sub


 &e
0
 
LVL 2

Expert Comment

by:andymcooper
ID: 13810106
looks like I overlapped with fanpages.

His solutions looks more thorough!

&e
0
 

Author Comment

by:dbfromnewjersey
ID: 13815298
fanpages,
 
     Thanks so much.  Works great.  You're a genius.
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 13816095
:)  You're too kind.

Thanks for the points/grading.

BFN,

fp.
[ http://NigelLee.info ]
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
If you’re using QODBC to update QuickBooks data from Microsoft® Access but Access is not showing the updated data, you could have set up QODBC incorrectly.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses

850 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