Export to Excel for quotes

A

adh123

Registered User.
Local time
Today, 15:28
Joined
Jan 14, 2015
Messages
77
We have a template which is quite specific - but basic - for our accounts team (please see the attached example) and I am trying to export data from access to excel, ideally to fit in this template where possible. Currently I am banging my head against a wall, I can export to excel however not a clue how to keep the formatting! :banghead:

Also included screenshots of the table structure (Main parent tblQuote and sub-table tblQuoteLineItems) - any suggestions on best practice here would be very much appreciated!

The user will create the quote from a form which displays the line items (tblQuoteLineItems) with matching q_id (from tblQuote), hopefully by a simple 1 button press!

My first thought was to have 2 queries run one after the other - 1 pulling the address data, the 2nd with the quote information.

Any advise or being pointed in the right direction is much appreciated! Have self taught basic access/data skills (most through searches and this forum!) so any suggestions are much appreciated.
 

Attachments

  • form.png
    form.png
    18.6 KB · Views: 169
  • tables.png
    tables.png
    18.6 KB · Views: 160
  • quote layout.png
    quote layout.png
    11.9 KB · Views: 160
It is entirely possible to output the data as per your template, but it will be quite a bit of work to get the formatting as you want it.

Here's a code snippet to get you started.

Code: 
'Function to export query to excel
Public Function Query_Excel(strQry_Name As String, strSheet_Name As String)

On Error GoTo Err_Query_Excel

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim prm As DAO.Parameter
Dim obExcel As Object
Dim intStart As Integer
Dim intCol As Integer

Set db = CurrentDb()

'Set data query
On Error Resume Next

Set qdf = db.QueryDefs(strQry_Name)

'Resolve parameters
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)

Next prm

Set rst = qdf.OpenRecordset()

'Check if there is data to add*******************************************
With rst
    If .RecordCount <> 0 Then
        intCol = .Fields.Count

    Else
        GoTo Exit_No_Data

    End If

End With

'Open a new excel workbook and add all the necessary sheets
Set obExcel = CreateObject("Excel.Application")

With obExcel
    .Workbooks.Add

    'Incase sheet does not exist
    On Error Resume Next

    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete

    'Resume normal error trap
    On Error GoTo Err_Query_Excel

    With obExcel
        If .ActiveSheet.Name = "Sheet1" Then
            .ActiveSheet.Name = strSheet_Name

            'Add column headers******************************************************
            For intStart = 1 To intCol
                .Cells(1, intStart).Value = rstQry.Fields(intStart - 1).Name

            Next

            'Add data****************************************************************
            .Cells.Range("A2").CopyFromRecordset rst

            'Final formatting********************************************************
            With .ActiveSheet.UsedRange
                .HorizontalAlignment = xlLeft
                .Autofilter

            End With

            'Force the width of the columns before autofit to ensure snap back******
            .ActiveSheet.UsedRange.ColumnWidth = 150

            'Autofit columns/rows***************************************************
            .ActiveSheet.Columns.AutoFit
            .ActiveSheet.Rows.AutoFit

            'Select specific cell***************************************************
            .ActiveSheet.Range("A1").Select

        End If

    End With

    .Sheets(1).Select

    'Make workbook visible
    .Visible = True

End With

Exit_Query_Excel:
    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    Set obExcel = Nothing

    Exit Function

Exit_No_Data:
    MsgBox "There are no records to output for this selection." & vbNewLine & _
           "" & vbNewLine & _
           "Alter your variables and then try again.", vbInformation, "No Data"

    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    Set obExcel = Nothing

    Exit Function

Err_Query_Excel:
    MsgBox Err.Description
    Resume Exit_Query_Excel

End Function
 
The method proposed in the previous post creates a new workbook, dumps the data and does some formatting.

I would use your existing template , saved as an Excel template, and open an instance of it as a new document. Then open recordsets, one with the address details, other with order details from your queries. Then use Automation to paste the values into the appropriate cells.

This way you have the output in the standard format and in the right cells.
 
Ok I have made some progress with this now with the help of the previous code and some searching...

Code: 
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstenq As DAO.Recordset
Dim rstquo As DAO.Recordset
Dim rstqlivat As DAO.Recordset
Dim rstqlinon As DAO.Recordset
[COLOR="red"]Dim rstSupplier As DAO.Recordset[/COLOR]

Dim obExcel As Object
Dim intStart As Integer
Dim intCol As Integer
Dim iRow As Integer

Set db = CurrentDb()

Set rst = db.OpenRecordset("SELECT * FROM tblCompany WHERE c_id = " & Me.c_id)
Set rstenq = db.OpenRecordset("SELECT * FROM tblEnquiries WHERE e_id = " & Me.e_id)
Set rstquo = db.OpenRecordset("SELECT * FROM tblQuote WHERE q_id = " & Me.q_id)
Set rstqlivat = db.OpenRecordset("SELECT * FROM tblQuoteLineItems WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1")
Set rstqlinon = db.OpenRecordset("SELECT * FROM tblQuoteLineItems WHERE q_id = " & Me.q_id & " And qli_vatable = " & "0")
[COLOR="Red"]Set rstSupplier = db.OpenRecordset("SELECT * FROM tblDrpSuppliers ORDER BY ID")[/COLOR]

'Open a new excel workbook and add all the necessary sheets
Set obExcel = CreateObject("Excel.Application")

With obExcel
    .Workbooks.Add

    'Incase sheet does not exist
    On Error Resume Next

    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete

    With obExcel
        If .activesheet.Name = "Sheet1" Then
            .activesheet.Name = strSheet_Name

            'Add column headers******************************************************

            .activesheet.cells(1, 1) = Me.cmbPerson
            .activesheet.cells(2, 1) = Me.c_name
            .activesheet.cells(3, 1) = rst.Fields(3)
            .activesheet.cells(4, 1) = rst.Fields(4)
            .activesheet.cells(5, 1) = rst.Fields(5)
            .activesheet.cells(6, 1) = rst.Fields(6)
            .activesheet.cells(7, 1) = rst.Fields(7)
            .activesheet.cells(8, 1) = rst.Fields(8)
            .activesheet.cells(10, 1) = "Enquiry:"
            .activesheet.cells(10, 2) = rstenq.Fields(2)
            .activesheet.cells(11, 1) = "Quote:"
            .activesheet.cells(11, 2) = rstquo.Fields(2)
            .activesheet.cells(13, 1) = "Item"
            .activesheet.cells(13, 2) = "Qty in unit"
            .activesheet.cells(13, 3) = "No. of units"
            .activesheet.cells(13, 4) = "Sell"
            .activesheet.cells(13, 5) = "Cost"
            .activesheet.cells(13, 6) = "Supplier"
            .activesheet.cells(13, 7) = "Profit"


'Begin inserting VAT able items************************

            rstqlivat.MoveLast
            rstqlivat.MoveFirst
            rstSupplier.MoveLast
            rstSupplier.MoveFirst
            iRow = 14
            For i = 1 To rstqlivat.RecordCount + 1
            
            .activesheet.cells(iRow, 1) = rstqlivat.Fields(2)
            .activesheet.cells(iRow, 2) = rstqlivat.Fields(6)
            .activesheet.cells(iRow, 3) = rstqlivat.Fields(5)
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlivat.Fields(10)
            .activesheet.cells(iRow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 5) = rstqlivat.Fields(8)

[COLOR="Red"]            'Supplier name held in tblDrpSuppliers

            rstSupplier.Seek "=", rstqlivat.Fields(4)
            
            .activesheet.cells(iRow, 6) = rstSupplier.Fields(1)[/COLOR]
            .activesheet.cells(iRow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 7) = rstqlivat.Fields(12)
            
            iRow = iRow + 1
            rstqlivat.MoveNext
            Next i

'Now insert non VATable items*****************************

            iRow = iRow + 2
            .activesheet.cells(iRow - 1, 1) = "Non VATable items"
            
            rstqlinon.MoveLast
            rstqlinon.MoveFirst
            
            For i = 1 To rstqlinon.RecordCount + 1
            
            .activesheet.cells(iRow, 1) = rstqlinon.Fields(2)
            .activesheet.cells(iRow, 2) = rstqlinon.Fields(6)
            .activesheet.cells(iRow, 3) = rstqlinon.Fields(5)
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlinon.Fields(10)
            .activesheet.cells(iRow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 5) = rstqlinon.Fields(8)
            .activesheet.cells(iRow, 6) = rstqlinon.Fields(4)
            .activesheet.cells(iRow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 7) = rstqlinon.Fields(12)
            
            iRow = iRow + 1
            rstqlinon.MoveNext
            Next i

            End If

    End With

    .Sheets(1).Select

    'Make workbook visible
    .Visible = True

End With

    Set obExcel = Nothing

End Sub

This exports everything fine (or seems to!) except Supplier. The supplier is stored as qli_supplier on each line of the tblQuoteLineItems as a number which links back to tblDrpSuppliers.
tblDrpSuppliers consists of the Primary key (qli_supplier value links to this) and Supplier_name.
The red code above places the first record in the tblDrpSuppliers in the excel file as opposed to the correct record, any suggestions where I am going wrong?
 
Last edited:
Firstly, you would make it easier on anyone reading or maintaining your code (including yourself), if you referred to Field names rather than numbers in
something = rst!Amount rather than rst. Fields (4)

To find the supplier record, use rst. Find First rather than seek.

Rstsupplier.findfirst "SupplierName='" & rstqlvivAt!SupplierName & "'"
 
Cronk said:
Firstly, you would make it easier on anyone reading or maintaining your code (including yourself), if you referred to Field names rather than numbers in
something = rst!Amount rather than rst. Fields (4)
Click to expand...

Was not aware I could do that, much easier - thanks :)

Rstsupplier.findfirst "Supp_Name='" & rstqlvivAt!qli_supplier & "'"
Click to expand...

The above (supp_name is the descriptive field in tblDrpSuppliers and qli_supplier is the field storing the matching numerical value in tblQuoteLineItems) still has the same effect i.e. only displaying the first record in tblDrpSupplier, not the name associated with the number stored in tblQuoteLineItems!qli_supplier.
 
Are you sure that the find is finding the record?

I'd add a line above, so that you would have

debug.print "Supp_Name='" & rstqlvivAt!qli_supplier & "'"
Rstsupplier.findfirst "Supp_Name='" & rstqlvivAt!qli_supplier & "'"

This way you can see in the immediate window what you are searching for.

You can test if a match is found with
if Rstsupplier.nomatch = false then

PS don't blame me for the double negative - that's Access VBA
 
rstSupplier.FindFirst "supp_name='" & rstqlivat!qli_supplier & "'"
Debug.Print "supp_name='" & rstqlivat!qli_supplier & "'"

Produces the below in the immediate:

supp_name='2
supp_name='1
supp_name='1
supp_name='1
supp_name='1
supp_name='1
supp_name='1
supp_name='1
supp_name='12
supp_name='14

However .activesheet.cells(iRow, 6) = rstSupplier!Supp_name still only pastes the 1st value in tblDrpSuppliers in the excel file.
 
Last edited:
Now finally have it working - in a sense!

Code: 
Private Sub btnCostSheet_Click()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstenq As DAO.Recordset
Dim rstquo As DAO.Recordset
Dim rstqlivat As DAO.Recordset
Dim rstqlinon As DAO.Recordset
Dim rstSuppliers As DAO.Recordset

Dim obExcel As Object
Dim intStart As Integer
Dim intCol As Integer
Dim iRow As Integer

Set db = CurrentDb()

Set rst = db.OpenRecordset("SELECT * FROM tblCompany WHERE c_id = " & Me.c_id)
Set rstenq = db.OpenRecordset("SELECT * FROM tblEnquiries WHERE e_id = " & Me.e_id)
Set rstquo = db.OpenRecordset("SELECT * FROM tblQuote WHERE q_id = " & Me.q_id)
Set rstqlivat = db.OpenRecordset("SELECT * FROM tblQuoteLineItems WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1")
Set rstqlinon = db.OpenRecordset("SELECT * FROM tblQuoteLineItems WHERE q_id = " & Me.q_id & " And qli_vatable = " & "0")

Set obExcel = CreateObject("Excel.Application")

With obExcel
    .Workbooks.Add

    'Incase sheet does not exist
    On Error Resume Next

    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete

    'Resume normal error trap
    'On Error GoTo Err_Query_Excel

    With obExcel
        If .activesheet.Name = "Sheet1" Then
            .activesheet.Name = strSheet_Name

            'Add column headers******************************************************

            .activesheet.cells(1, 1) = Me.cmbPerson.Column(2)
            .activesheet.cells(2, 1) = Me.c_name
            .activesheet.cells(3, 1) = rst!c_add1
            .activesheet.cells(4, 1) = rst!c_add2
            .activesheet.cells(5, 1) = rst!c_add3
            .activesheet.cells(6, 1) = rst!c_add4
            .activesheet.cells(7, 1) = rst!c_county
            .activesheet.cells(8, 1) = rst!c_postcode
            .activesheet.cells(10, 1) = "Enquiry:"
            .activesheet.cells(10, 2) = rstenq!e_name
            .activesheet.cells(11, 1) = "Quote:"
            .activesheet.cells(11, 2) = rstquo!q_name
            .activesheet.cells(13, 1) = "Item"
            .activesheet.cells(13, 2) = "Qty in unit"
            .activesheet.cells(13, 3) = "No. of units"
            .activesheet.cells(13, 4) = "Sell"
            .activesheet.cells(13, 5) = "Cost"
            .activesheet.cells(13, 6) = "Supplier"
            .activesheet.cells(13, 7) = "Profit"

            rstqlivat.MoveLast
            rstqlivat.MoveFirst
            iRow = 14
            For i = 1 To rstqlivat.RecordCount + 1
            
            .activesheet.cells(iRow, 1) = rstqlivat!qli_line_item
            .activesheet.cells(iRow, 2) = rstqlivat!qli_per
            .activesheet.cells(iRow, 3) = rstqlivat!qli_quantity
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlivat!qli_sell
            .activesheet.cells(iRow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 5) = rstqlivat!qli_cost
            .activesheet.cells(iRow, 6) = rstqlivat!qli_supplier
            
            Dim iSql As Integer
            
            iSql = .activesheet.cells(iRow, 6)
            Set rstSuppliers = db.OpenRecordset("SELECT * FROM tblDrpSuppliers WHERE supp_id = '" & iSql & "'")
            .activesheet.cells(iRow, 6) = rstSuppliers!Supp_name
            
            .activesheet.cells(iRow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 7) = rstqlivat!qli_profit
            
            iRow = iRow + 1
            rstqlivat.MoveNext
            
            Next i

            iRow = iRow + 2
            .activesheet.cells(iRow - 1, 1) = "Non VATable items"
            
            rstqlinon.MoveLast
            rstqlinon.MoveFirst
            
            For i = 1 To rstqlinon.RecordCount + 1
            
            .activesheet.cells(iRow, 1) = rstqlinon!qli_line_item
            .activesheet.cells(iRow, 2) = rstqlinon!qli_per
            .activesheet.cells(iRow, 3) = rstqlinon!qli_quantity
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlinon!qli_sell
            .activesheet.cells(iRow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 5) = rstqlinon!qli_cost
            .activesheet.cells(iRow, 6) = rstqlinon!qli_supplier
            
            [COLOR="Red"]iSql = .activesheet.cells(iRow, 6)
            Set rstSuppliers = db.OpenRecordset("SELECT * FROM tblDrpSuppliers WHERE supp_id = '" & iSql & "'")
            .activesheet.cells(iRow, 6) = rstSuppliers!Supp_name[/COLOR]
            
            .activesheet.cells(iRow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 7) = rstqlinon!qli_profit
            
            iRow = iRow + 1
            rstqlinon.MoveNext
            Next i

            End If

    End With

    .Sheets(1).Select

    'Make workbook visible
    .Visible = True

End With

'Exit_Query_Excel:
'    Set rst = Nothing
 '   Set qdf = Nothing
  '  Set db = Nothing
    Set obExcel = Nothing
    Set rst = Nothing
    Set rstenq = Nothing
    Set rstquo = Nothing
    Set rstqlivat = Nothing
    Set rstqlinon = Nothing
    Set rstSuppliers = Nothing
    
Set obExcel = Nothing

End Sub

Everything worked extracting from tblQuoteLineItems into excel except for the supplier names - which are stored in a seperate table.

The only way I could think of getting it to work is to send the numerical value stored in tblQuoteLineItems to Excel and using this value to look up from the supplier table (red code above) and overwriting the cell. Trying to do this in a new recordset would result in blank values.

If there is a neater/simpler way of doing this or something I have overlooked in the code I would much appreciate the feedback!
 
Isn't this code (which is in your loop above the red highlight)
Code: 
iSql = .activesheet.cells(iRow, 6)
Set rstSuppliers = db.OpenRecordset("SELECT * FROM tblDrpSuppliers WHERE supp_id = '" & iSql & "'") 
activesheet.cells(iRow, 6) = rstSuppliers!Supp_name

'Single quotes are used in the opening of the recordset because supp-id is a text field
putting the supplier name into the cell?

BTW don't you get a run time error in the loop
For i = 1 To rstqlivat.RecordCount + 1
when the code tries to read past the end of the recordset?
 
Hi Cronk

In short, it puts the ID in the field, then reads this and queries tblDrpSupplier for the supp_name.

The table tblDrpSuppliers has 2 columns:
ID (Autonumber)
supp_name (text field)

When I tried to identify the correct value using
Rstsupplier.findfirst "Supp_Name='" & rstqlivAt!qli_supplier & "'"
only the first record in tblDrpSuppliers was being displayed against each line item.
I put in some message boxes at each of the 2 stages and ID was being displayed correctly , however the supp_name was not.
So the process now exports the ID to the supplier field in excel, the 2nd piece of code then looks up the supp_name based on this field as a separate query.


No errors from For i = 1 To rstqlivat.RecordCount + 1, should it read For i = 1 To rstqlivat.recordcount without the + 1?

Most of this has been pulled from google searches and what I have gleaned from here so there may be neater ways of doing this!
 
Did you read my question in the previous post?
 
You mentioned in post #7 that qli_supplier is a numerical ID foreign key. Unless i am misinterpreting something, the reason...
Code: 
Rstsupplier.findfirst "Supp_Name='" & rstqlivAt!qli_supplier & "'"
...is not working is because essentially you are saying "hey access, show me the the first supplier you come across whose supplier name matches this ID value".

It should read:

Code: 
Rstsupplier.findfirst "supp_id=" & rstqlivAt!qli_supplier

Leaving the above aside, If it were me, i would change your SQL for rstqlivat from

Code: 
SELECT * FROM tblQuoteLineItems WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1"

to

Code: 
SELECT tblQuoteLineItems.*, tblDrpSuppliers.Supp_Name 
FROM tblDrpSuppliers INNER JOIN tblQuoteLineItems ON tblDrpSuppliers.supp_id = tblQuoteLineItems.qli_supplier
WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1"

Using the above, you would then have the supplier name available in the rst you are iterating through, so you can just:

Code: 
.activesheet.cells(iRow, 6) = rstqlivat!Supp_Name
 
Sorry Cronk, it had been a long day and had miss read your question. Yes it puts the supplier name into the cell by looking at the data already dumped into the cell.

Pyro that tidies up the code wonderfully, thank you both very much for your help! :D
 
Hi there

Now that the code below is working nicely I am trying to find ways in which I can make it look neater and reduce the manual formatting completed by the end users.

Is it possible to put in a new line break whenever the category (stored in qli_category) changes? Or is it a case of creating multiple versions of the code below highlighted in red (would result in 14 recordsets in total - not sure if this is overkill)?

Code: 
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstenq As DAO.Recordset
Dim rstquo As DAO.Recordset
Dim rstqlivat As DAO.Recordset
Dim rstqlinon As DAO.Recordset

Dim obExcel As Object
Dim intStart As Integer
Dim intCol As Integer
Dim irow As Integer

Set db = CurrentDb()

Set rst = db.OpenRecordset("SELECT * FROM tblCompany WHERE c_id = " & Me.c_id)
Set rstenq = db.OpenRecordset("SELECT * FROM tblEnquiries WHERE e_id = " & Me.e_id)
Set rstquo = db.OpenRecordset("SELECT * FROM tblQuote WHERE q_id = " & Me.q_id)
[COLOR="Red"]Set rstqlivat = db.OpenRecordset("SELECT tblQuoteLineItems.*, tblDrpSuppliers.supp_name FROM tblDrpSuppliers INNER JOIN tblQuoteLineItems ON tblDrpSuppliers.ID = tblQuoteLineItems.qli_supplier WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1 ORDER BY qli_order")

Set rstqlinon = db.OpenRecordset("SELECT tblQuoteLineItems.*, tblDrpSuppliers.supp_name FROM tblDrpSuppliers INNER JOIN tblQuoteLineItems ON tblDrpSuppliers.ID = tblQuoteLineItems.qli_supplier WHERE q_id = " & Me.q_id & " And qli_vatable = " & "0 ORDER BY qli_order")[/COLOR]

Set obExcel = CreateObject("Excel.Application")

With obExcel
    .workbooks.Add

    'Incase sheet does not exist
    On Error Resume Next

    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete

    With obExcel
        If .activesheet.Name = "Sheet1" Then
            .activesheet.Name = strSheet_Name

            'Add column headers******************************************************

            .activesheet.cells(1, 1) = Me.cmbPerson.Column(2)
            .activesheet.cells(2, 1) = Me.c_name
            .activesheet.cells(3, 1) = rst!c_add1
            .activesheet.cells(4, 1) = rst!c_add2
            .activesheet.cells(5, 1) = rst!c_add3
            .activesheet.cells(6, 1) = rst!c_add4
            .activesheet.cells(7, 1) = rst!c_county
            .activesheet.cells(8, 1) = rst!c_postcode
            .activesheet.cells(10, 1) = "Quote Number:" & " " & rstquo!q_creator & rstquo!q_id
            .activesheet.cells(11, 1) = "Quote Name:" & " " & rstquo!q_name
            .activesheet.cells(13, 1).Font.Bold = True
            .activesheet.cells(13, 1) = "VATable items"
            .activesheet.cells(14, 1).Font.Bold = True
            .activesheet.cells(14, 1) = "Item"
            .activesheet.cells(14, 2).Font.Bold = True
            .activesheet.cells(14, 2) = "Qty in unit"
            .activesheet.cells(14, 3).Font.Bold = True
            .activesheet.cells(14, 3) = "No. of units"
            .activesheet.cells(14, 4).Font.Bold = True
            .activesheet.cells(14, 4) = "Sell"
            .activesheet.cells(14, 5).Font.Bold = True
            .activesheet.cells(14, 5) = "Cost"
            .activesheet.cells(14, 6).Font.Bold = True
            .activesheet.cells(14, 6) = "Supplier"
            .activesheet.cells(14, 7).Font.Bold = True
            .activesheet.cells(14, 7) = "Profit"

            'Move last and first, cycle through records******************************************************

            rstqlivat.MoveLast
            rstqlivat.MoveFirst
            irow = 15
            For i = 1 To rstqlivat.RecordCount
            
            'Add data ******************************************************
            
            .activesheet.cells(irow, 1) = rstqlivat!qli_line_item
            .activesheet.cells(irow, 2) = rstqlivat!qli_per
            .activesheet.cells(irow, 3) = rstqlivat!qli_quantity
            .activesheet.cells(irow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 4) = rstqlivat!qli_sell
            .activesheet.cells(irow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 5) = rstqlivat!qli_cost
            .activesheet.cells(irow, 6) = rstqlivat!Supp_name
            .activesheet.cells(irow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 7).Font.Italic = True
            .activesheet.cells(irow, 7) = rstqlivat!qli_profit
            
            irow = irow + 1
            rstqlivat.MoveNext
            
            Next i

            irow = irow + 3
            .activesheet.cells(irow - 2, 1).Font.Bold = True
            .activesheet.cells(irow - 2, 1) = "Non VATable items"
            
            .activesheet.cells(irow - 1, 1).Font.Bold = True
            .activesheet.cells(irow - 1, 1) = "Item"
            .activesheet.cells(irow - 1, 2).Font.Bold = True
            .activesheet.cells(irow - 1, 2) = "Qty in unit"
            .activesheet.cells(irow - 1, 3).Font.Bold = True
            .activesheet.cells(irow - 1, 3) = "No. of units"
            .activesheet.cells(irow - 1, 4).Font.Bold = True
            .activesheet.cells(irow - 1, 4) = "Sell"
            .activesheet.cells(irow - 1, 5).Font.Bold = True
            .activesheet.cells(irow - 1, 5) = "Cost"
            .activesheet.cells(irow - 1, 6).Font.Bold = True
            .activesheet.cells(irow - 1, 6) = "Supplier"
            .activesheet.cells(irow - 1, 7).Font.Bold = True
            .activesheet.cells(irow - 1, 7) = "Profit"
                        
            rstqlinon.MoveLast
            rstqlinon.MoveFirst
            
            For i = 1 To rstqlinon.RecordCount
            
            .activesheet.cells(irow, 1) = rstqlinon!qli_line_item
            .activesheet.cells(irow, 2) = rstqlinon!qli_per
            .activesheet.cells(irow, 3) = rstqlinon!qli_quantity
            .activesheet.cells(irow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 4) = rstqlinon!qli_sell
            .activesheet.cells(irow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 5) = rstqlinon!qli_cost
            .activesheet.cells(irow, 6) = rstqlinon!Supp_name
            .activesheet.cells(irow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 7).Font.Italic = True
            .activesheet.cells(irow, 7) = rstqlinon!qli_profit
            
            irow = irow + 1
            rstqlinon.MoveNext
            Next i
            
            'Add totals **********************************************
                        
            irow = irow + 1
            .activesheet.cells(irow, 1).Font.Bold = True
            .activesheet.cells(irow, 1) = "Subtotal"
            .activesheet.cells(irow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 4) = Me.txtq_sell_subtotal
            .activesheet.cells(irow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 5) = Me.txtq_cost_subtotal
            .activesheet.cells(irow, 7).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 7).Font.Italic = True
            .activesheet.cells(irow, 7) = Me.txtq_profit
            
            irow = irow + 1
            .activesheet.cells(irow, 1).Font.Bold = True
            .activesheet.cells(irow, 1) = "VAT"
            .activesheet.cells(irow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 4) = Me.txtq_sell_vat
            .activesheet.cells(irow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 5) = Me.txtq_cost_vat
            
            irow = irow + 1
            .activesheet.cells(irow, 1).Font.Bold = True
            .activesheet.cells(irow, 1) = "Total"
            .activesheet.cells(irow, 4).Font.Bold = True
            .activesheet.cells(irow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 4) = Me.txtq_sell_total
            .activesheet.cells(irow, 5).Font.Bold = True
            .activesheet.cells(irow, 5).numberformat = "£#,##0.00"
            .activesheet.cells(irow, 5) = Me.txtq_cost_total
            
            'change size of columns in excel *******************************
            
            .columns("B:G").autofit
            .columns("A:A").ColumnWidth = 50
        End If

    End With

    .Sheets(1).Select

    'Make workbook visible
    .Visible = True

End With



'Close recordsets and database******************************************************

Set db = Nothing
Set obExcel = Nothing
Set rst = Nothing
Set rstenq = Nothing
Set rstquo = Nothing
Set rstqlivat = Nothing
Set rstqlinon = Nothing
Set rstSuppliers = Nothing
Set obExcel = Nothing
 
You must log in or register to reply here.

Similar threads

M
Export 2 forms to same spreadsheet
Replies
7
Views
920
mounty76
M
B
  • Question Question
export and transpose problem
Replies
6
Views
1,216
Gasman
Gasman
N
Solved Export data from Passthrough Query to CSV
Replies
18
Views
1,719
Gasman
Gasman
J
Use VBA to export form data to Excel, but keep getting "We Found a Problem..." when opening the file in Excel
Replies
5
Views
1,153
June7
June7
R
Access report "Overflow" error on export to HTML (PDF works fine)
2
Replies
27
Views
2,059
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom