How to export listbox values to Excel

[mafhobb]

Hi

On a form I have a listbox that gets its data from this query:

SELECT [Stats SKU Issue Type Percent].[IssueType], [Stats SKU Issue Type Percent].[Stats SKU Issue Type].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Stats SKU Issue Type Total].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Expr1] FROM [Stats SKU Issue Type Percent];

On the same form I have another listbox that gets its data from this other query:

SELECT [Stats SKU Return Error Percent].[ErrorCodes], [Stats SKU Return Error Percent].[CountOfCallID], [Stats SKU Return Error Percent].[CountOfErrorCodes], [Stats SKU Return Error Percent].[Expr1] FROM [Stats SKU Return Error Percent];

Both of these listboxes typically have anywhere from 10 to 25 rows.

These listboxes work well on the form, but now I have been asked to see if I could add a button to export his data to Excel.

What would be the process/strategy to do this?

mafhobb

 

[Ranman256]

Dont use sql, save the sql as a query, like qsListBoxEntries.

then export the query to excel
docmd.Transferspreadsheet "qsListBoxEntries"

 

[mafhobb]

Ok, I'll try that. But what about having the two queries export to the same excel sheet? How can I organize the data in the sheet. Nothing fancy, just a couple of headers, one set of results from the first query, then another set of headers and the results from the second query

mafhobb

 

[sneuberg]

I don't believe you can use the DoCmd.TransferSpreadsheet Method to export two queries to the same spreadsheet as the Range argument doesn't function for exports.

Maybe you can use the function Frothingslosh creating which you can find in the Export To Excel module of the attached database. This takes a record set as a argument so you would pass it the record set of the listbox.

I've never tried this or even tested this code so I can't tell you if this will work but it looks like it might.

 

[mafhobb]

Perhaps I can use the two queries to create a temporary table and then export the table to excel?

mafhobb

 

[mafhobb]

As I try to work out this code, I am trying to assign my query results to a recordset but I am running into an issue.

This works fine:

    SQL = "SELECT [Error Codes].ID, [Error Codes].ErrorCode, [Error Codes].Active FROM [Error Codes]"
    'Execute query and populate recordset
    Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

But if I change the query to my original query:

    SQL = "SELECT [Stats SKU Issue Type Percent].[IssueType], [Stats SKU Issue Type Percent].[Stats SKU Issue Type].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Stats SKU Issue Type Total].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Expr1] FROM [Stats SKU Issue Type Percent]"
    'Execute query and populate recordset
    Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

The I get "Too few parameters. Expected 1. error 3061"

Obviously the second query isn't generating any results here but I do not know why this is because it is populating a listbox during the formload event. I have tested the SQl separately in a new query and it also works. I think that this may have to do with the fact the the first query is pulling data directly from a table while the second one is is pulling data from another query.

I am at a loss about what to do...

mafhobb

 

[sneuberg]

I wanted to give you an example of using the code I suggested in post #4 but I'm having problems with it. I going to continue to putz with it and I'll let you know what I find, but if you want the listbox outputs in the same sheet within the same spreadsheet then the CopyFromRecordset method used by this code is the way to go. On the other hand if you could live with the listbox outputs being in different sheets then DoCmd.TransferSpreadsheet might still work for you. When you export to Excel it creates sheets with the query names. For example this code:

FilePath = "C:\Users\sneuberg\Desktop\ListBoxOutput.xlsx"
DoCmd.TransferSpreadsheet acExport, , "qryProducts", FilePath, True
DoCmd.TransferSpreadsheet acExport, , "qryInventoryTypes", FilePath, True

produces the ListBoxOutput.xlsx spreadsheet with sheets "qryProducts" and "qryInventoryTypes".

Concern creating a table unless the columns were of the same type and number I think it would be difficult to create a table from the queries.

Concerning your problem with record sets I don't see where the problem is from what you have posted, but I seen that error before and it's typically caused by having references in the query. Does the query [Stats SKU Issue Type Percent] have a form reference (e.g., Forms!NameOfForm!NameOfControl) in it? If so they need to be declared and this need to be handled with querydefs. Read this.

Also I suggest opening the stored querydef rather than have the SQL string in the code and dbOpenSnapshot probably isn't needed. Why did you choose it?

 

[mafhobb]

Sneuberg,

You are correct, two of my queries have a form reference. I have updated the code using the example in the link that you posted (Thank you!) However I still get he same error... here is the updated code:

     Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rs1 As DAO.Recordset
    Dim i As Integer
    
    Dim qdf1 As DAO.QueryDef
    Dim qdf2 As DAO.QueryDef
    
    Set db = CurrentDb()
    Set qdf1 = db.QueryDefs("Stats SKU Issue Type")
    qdf1("[forms]![FrmStatsSpecSKU]![txtSKU]") = [Forms]![FrmStatsSpecSKU]![txtSKU]
    
    Set qdf2 = db.QueryDefs("Stats SKU Issue Type Total")
    qdf2("[forms]![FrmStatsSpecSKU]![txtSKU]") = [Forms]![FrmStatsSpecSKU]![txtSKU]


    'SQL statement to retrieve data from database
    SQL = "SELECT [Stats SKU Issue Type Percent].[IssueType], [Stats SKU Issue Type Percent].[Stats SKU Issue Type].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Stats SKU Issue Type Total].[CountOfIssueTypeID], [Stats SKU Issue Type Percent].[Expr1] FROM [Stats SKU Issue Type Percent]"
    'Execute query and populate recordset
    Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

Do you see anything wrong with this code?

mafhobb

 

[sneuberg]

You can see in the example code in the link I provided that the recordset is opened using the querydef object. Something like

  Set rs1 = qdf1.OpenRecordset(  )

rather than

  Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

 

[mafhobb]

Set rs1 = qdf1.OpenRecordset()

This does work, but please, can you explain why it is "...qdf1.Openrecor..." that I am using and not "...qdf2.Open..."?

I mean, what does the definition for qdf2 do in this code?

I guess I probably just coded it wrong when I defined qdf2? Does it even need to be defined? I want to understand the logic so I know what to do next time i run into this...

mafhobb

 

[sneuberg]

I haven't done this with composite queries so I'm not sure about this but I think you just need to declare the parameters in the one that you are using even though it doesn't have the reference directly in it. I suggest commenting out the qdf2 stuff and see if it still works.

 

[mafhobb]

Yes, I commented qdf2 out and it still works so my guess is that once a qdef is set referencing a field in a form, if other queries use the same field (which is exactly what happens in my other query), then it already knows what the reference is and it does not need to be defined again.

Could this be it?

mafhobb

 

[sneuberg]

Yes, I commented qdf2 out and it still works so my guess is that once a qdef is set referencing a field in a form, if other queries use the same field (which is exactly what happens in my other query), then it already knows what the reference is and it does not need to be defined again.

Could this be it?

mafhobb

That would be my guess but I really don't know for sure. If you want an answer to this I suggest starting a new thread with this question. I'm a little curious about this too.

 

[sneuberg]

Just an update on the Frothingslosh's function. I'm making progress. The code had a couple of bugs and wasn't designed to use an existing worksheet for output. I just got it to produce an output from two queries in the same worksheet but there's a lot of cleaning up to do. I hope to post something by early tomorrow.

 

[sneuberg]

I've attached a database with a revised Export to Excel module. If you choose to use the ExportToExcel function I suggest you just import the module into your project. The attached database includes an example export of two queries. I was having problems exporting the record sets of the listboxes and so the code just open record sets of the queries and passes them to the ExportToExcel function.

 

[mafhobb]

This is what ended up working for me. It is not cleaned up yet.

' Defining variable
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim Firsti As Integer
    Dim Secondi As Integer
    Dim Thirdi As Integer
    Dim qdf1 As DAO.QueryDef
    Dim qdf2 As DAO.QueryDef
    Dim qdf3 As DAO.QueryDef
    Dim RowNumber As Integer
    Dim Count As Integer
    Dim FixedTotal As Integer
        
    'Make sure that we are using the current db
    Set db = CurrentDb()
    'Set the row counters to zero
    Firsti = 0
    Secondi = 0
    Thirdi = 0
    
    'Set the query definitions
    Set qdf1 = db.QueryDefs("Stats SKU Issue Type")
    qdf1("[forms]![FrmStatsSpecSKU]![txtSKU]") = [Forms]![FrmStatsSpecSKU]![txtSKU]
    'This query definition:[Forms]![FrmStatsSpecSKU]![txtSKU] is also being used in Stats SKU Issue Totals",
    'but since it is already defined here, we do not need to do it again.
    Set qdf2 = db.QueryDefs("Stats SKU Return Errors")
    qdf2("[forms]![FrmStatsSpecSKU]![txtSKU]") = [Forms]![FrmStatsSpecSKU]![txtSKU]
    'This query definition:[Forms]![FrmStatsSpecSKU]![txtSKU] is also being used in Stats SKU Issue Totals",
    'but since it is already defined here, we do not need to do it again.
    Set qdf3 = db.QueryDefs("Stats SKU Resolution")
    qdf3("[forms]![FrmStatsSpecSKU]![txtSKU]") = [Forms]![FrmStatsSpecSKU]![txtSKU]
    'This query definition:[Forms]![FrmStatsSpecSKU]![txtSKU] is also being used in Stats SKU Issue Totals",
    'but since it is already defined here, we do not need to do it again.
    
    'Show user work is being performed
    DoCmd.Hourglass (True)

    '              RETRIEVE DATA
    'First Recordset
    'SQL statement to retrieve data from database for the first set of data
    SQL = "SELECT [Stats SKU Issue Type Percent].[IssueType], [Stats SKU Issue Type Percent].[Stats SKU Issue Type].[CountOfIssueTypeID] FROM [Stats SKU Issue Type Percent]"
    'Execute query and populate recordset
    Set rs1 = qdf1.OpenRecordset()
    'Count the records in the first recordset
    Firsti = rs1.RecordCount
    
    'Second Recordset
    'SQL statement to retrieve data from database for the first set of data
'    SQL = "SELECT [Stats SKU Return Error Percent].[ErrorCodes], [Stats SKU Return Error Percent].[CountOfCallID], [Stats SKU Return Error Percent].[CountOfErrorCodes] FROM [Stats SKU Return Error Percent]"
    SQL = "SELECT [Stats SKU Return Error Percent].[ErrorCodes], [Stats SKU Return Error Percent].[CountOfCallID] FROM [Stats SKU Return Error Percent]"
    
    'Execute query and populate recordset
    Set rs2 = qdf2.OpenRecordset()
    'Count the records in the first recordset
    Secondi = rs2.RecordCount
    
    'Third Recordset
    'SQL statement to retrieve data from database for the first set of data
'    SQL = "SELECT [Stats SKU Resolution Percent].[ResolutionDetails], [Stats SKU Resolution Percent].[Stats SKU Resolution].[CountOfResolutionDetails] FROM [Stats SKU Resolution Percent]"
    SQL = "SELECT [Stats SKU Resolution Percent].[ResolutionDetails], [Stats SKU Resolution Percent].[Stats SKU Resolution].[CountOfResolutionDetails] FROM [Stats SKU Resolution Percent]"
    'Execute query and populate recordset
    Set rs3 = qdf3.OpenRecordset()
    'Count the records in the first recordset
    Thirdi = rs3.RecordCount
    'MsgBox Thirdi

  
    '             BUILD SPREADSHEET
    'Create an instance of Excel and start building a spreadsheet
    'Early Binding
    
    Set xlApp = Excel.Application
    xlApp.Visible = False
    Set xlBook = xlApp.Workbooks.Add
    
    Set xlSheet = xlBook.Worksheets(1)
    With xlSheet
        .Name = [Forms]![FrmStatsSpecSKU]![txtSKU]
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
  
        'Set column widths
        .Columns("A").ColumnWidth = 8.5
        .Columns("B").ColumnWidth = 45
        .Columns("C").ColumnWidth = 18
        .Columns("D").ColumnWidth = 12.5
        
        'Add title
        .Range("A1").Value = "Specielle Artikle Statistik"
        .Range("A1", "E1").Merge
        .Range("A1").HorizontalAlignment = xlCenter
        .Range("A1").Cells.Font.Bold = True
        .Range("A1").Cells.Font.Underline = True
        .Range("A1").RowHeight = 21
        .Range("A1").Font.Size = 16
        
        
        'Add header info
        .Range("A3").Value = "Artikel:"
        .Range("A3").Cells.Font.Bold = True
        .Range("B3").Value = [Forms]![FrmStatsSpecSKU]![txtSKU]
        .Range("B3").HorizontalAlignment = xlCenter
        
        .Range("A4").Value = "Date:"
        .Range("A4").Cells.Font.Bold = True
        .Range("B4").Value = Date
        .Range("B4").HorizontalAlignment = xlCenter
        
        .Range("C3").Value = "Erste Reklamation:"
        .Range("C3").Cells.Font.Bold = True
        .Range("D3").Value = [Forms]![FrmStatsSpecSKU]![txtFirstIssue]
        .Range("D3").HorizontalAlignment = xlCenter
        
        .Range("C4").Value = "Letzte Reklamation:"
        .Range("C4").Cells.Font.Bold = True
        .Range("D4").Value = [Forms]![FrmStatsSpecSKU]![txtLastIssue]
        .Range("D4").HorizontalAlignment = xlCenter
        
        .Range("C5").Value = "Reklamation Ges.:"
        .Range("C5").Cells.Font.Bold = True
        .Range("D5").Value = [Forms]![FrmStatsSpecSKU]![txtTotIssues]
        .Range("D5").HorizontalAlignment = xlCenter
        
        .Range("C6").Value = "Kontakte Ges.:"
        .Range("C6").Cells.Font.Bold = True
        .Range("D6").Value = [Forms]![FrmStatsSpecSKU]![txtTotContacts]
        .Range("D6").HorizontalAlignment = xlCenter
        
        .Range("C7").Value = "Average Kont./Rekl."
        .Range("C7").Cells.Font.Bold = True
        .Range("D7").Value = [Forms]![FrmStatsSpecSKU]![txtContactsAv]
        .Range("D7").HorizontalAlignment = xlCenter
        
        'Format the header date fields
        .Range("D3").NumberFormat = "d/m/yy"
        .Range("D4").NumberFormat = "d/m/yy"
                
        'Add Reklamationsgrund column headers (1st set of data)
        .Range("B9").Value = "Reklamationsgrund (Prozentual)"
        .Range("B9").Cells.Font.Bold = True
        .Range("B10").Value = "Reklamations Art"
        .Range("B10").Cells.Font.Bold = True
        .Range("B10").HorizontalAlignment = xlCenter
        .Range("C10").Value = "Wie Viele?"
        .Range("C10").Cells.Font.Bold = True
        .Range("C10").HorizontalAlignment = xlCenter
        .Range("D10").Value = "% Gesamt"
        .Range("D10").Cells.Font.Bold = True
        .Range("D10").HorizontalAlignment = xlCenter
        .Range("B" & Firsti + 11).Value = "Total"
        .Range("B" & Firsti + 11).HorizontalAlignment = xlRight
        .Range("B" & Firsti + 11).Cells.Font.Bold = True

        'Add first data, from the first recordset
        .Range("A11").CopyFromRecordset rs1
        
        'Add calculated values to the first set of data
        'Calculate total
        Count = 11
        Do While Not Count = 11 + Firsti
            RecTotal = RecTotal + .Range("C" & Count).Value
            Count = Count + 1
        Loop
        .Range("C" & Firsti + 11).Value = RecTotal
        .Range("C" & Firsti + 11).HorizontalAlignment = xlCenter
        .Range("C" & Firsti + 11).Cells.Font.Bold = True
        'Calculate percent
         Count = 11
         FixedTotal = Firsti + 11
        Do While Not Count = 11 + Firsti
            .Range("D" & Count).Formula = "=C" & Count & "/c" & FixedTotal & "* 100"
            .Range("D" & Count).Cells.NumberFormat = "0#.#0"
            .Range("D" & Count).HorizontalAlignment = xlCenter
            .Range("C" & Count).HorizontalAlignment = xlCenter
            Count = Count + 1
        Loop
       
        'Format fields for the first recordset
       
        'Add headers for second recordset
        RowNumber = Firsti + 12
        .Range("B" & RowNumber).Value = "Fehlercode (Prozentual)"
        .Range("B" & RowNumber).Cells.Font.Bold = True
        .Range("B" & RowNumber + 1).Value = "Code"
        .Range("B" & RowNumber + 1).Cells.Font.Bold = True
        .Range("B" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("C" & RowNumber + 1).Value = "Wie Viele?"
        .Range("C" & RowNumber + 1).Cells.Font.Bold = True
        .Range("C" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("D" & RowNumber + 1).Value = "% Gesamt"
        .Range("D" & RowNumber + 1).Cells.Font.Bold = True
        .Range("D" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("B" & Firsti + Secondi + 14).Value = "Total"
        .Range("B" & Firsti + Secondi + 14).HorizontalAlignment = xlRight
        .Range("B" & Firsti + Secondi + 14).Cells.Font.Bold = True
        
        'Add data from the second recordset
        RowNumber = RowNumber + 2
        .Range("A" & RowNumber).CopyFromRecordset rs2
        
        'Add calculated values to the second set of data
        'Calculate total
        Count = Firsti + 14
        'MsgBox Count
        Do While Not Count = Firsti + 14 + Secondi
            ErrorTotal = ErrorTotal + .Range("C" & Count).Value
            Count = Count + 1
        Loop
        .Range("C" & Firsti + 14 + Secondi).Value = ErrorTotal
        .Range("C" & Firsti + 14 + Secondi).HorizontalAlignment = xlCenter
        .Range("C" & Firsti + 14 + Secondi).Cells.Font.Bold = True
        FixedTotal = Firsti + 14 + Secondi
        'Calculate percent
         Count = Firsti + 14
        Do While Not Count = Firsti + 14 + Secondi
        '    MsgBox Count
            .Range("D" & Count).Formula = "=C" & Count & "/c" & FixedTotal & " * 100"
            .Range("D" & Count).Cells.NumberFormat = "0#.#0"
            .Range("D" & Count).HorizontalAlignment = xlCenter
            .Range("C" & Count).HorizontalAlignment = xlCenter
            Count = Count + 1
        Loop
        
        'Add headers for third recordset
        RowNumber = Firsti + Secondi + 15
        .Range("B" & RowNumber).Value = "Lösungsvorschläge (Prozentual)"
        .Range("B" & RowNumber).Cells.Font.Bold = True
        .Range("B" & RowNumber + 1).Value = "Ergebnis"
        .Range("B" & RowNumber + 1).Cells.Font.Bold = True
        .Range("B" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("C" & RowNumber + 1).Value = "Wie Viele?"
        .Range("C" & RowNumber + 1).Cells.Font.Bold = True
        .Range("C" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("D" & RowNumber + 1).Value = "% Gesamt"
        .Range("D" & RowNumber + 1).Cells.Font.Bold = True
        .Range("D" & RowNumber + 1).HorizontalAlignment = xlCenter
        .Range("B" & Firsti + Secondi + Thirdi + 17).Value = "Total"
        .Range("B" & Firsti + Secondi + Thirdi + 17).HorizontalAlignment = xlRight
        .Range("B" & Firsti + Secondi + Thirdi + 17).Cells.Font.Bold = True
        
        'Add data from the third recordset
        RowNumber = RowNumber + 2
        .Range("A" & RowNumber).CopyFromRecordset rs3
        
        'Add calculated values to the third set of data
        'Calculate total
        Count = Firsti + Secondi + 17
        Do While Not Count = Firsti + Secondi + Thirdi + 23
            'MsgBox Count
            ResolutionTotal = ResolutionTotal + .Range("C" & Count).Value
            Count = Count + 1
        Loop
        .Range("C" & Firsti + 17 + Secondi + Thirdi).Value = ResolutionTotal
        .Range("C" & Firsti + 17 + Secondi + Thirdi).HorizontalAlignment = xlCenter
        .Range("C" & Firsti + 17 + Secondi + Thirdi).Cells.Font.Bold = True
        FixedTotal = Firsti + Secondi + Thirdi + 17
        'Calculate percent
         Count = Firsti + Secondi + 17
        Do While Not Count = Firsti + 17 + Secondi + Thirdi
        '    MsgBox Count
            .Range("D" & Count).Formula = "=C" & Count & "/c" & FixedTotal & " * 100"
            .Range("D" & Count).Cells.NumberFormat = "0#.#0"
            .Range("D" & Count).HorizontalAlignment = xlCenter
            .Range("C" & Count).HorizontalAlignment = xlCenter
            Count = Count + 1
        Loop
        
        'Delete the values in column A that show the SKU number. Fromm A11 down.
        Count = 11
        Do While Not Count = Firsti + Secondi + Thirdi + 23
                .Range("A" & Count).Cells.Value = ""
                Count = Count + 1
        Loop
        
        'Add borders and colors to the boxes
        'Header Boxes on the left
        .Range("B3").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("B3").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("B3:B4").Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("B3:B4").Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("B3:B4").Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("B3:B4").Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        .Range("B4").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("B4").Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("B3:B4").Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
        .Range("B3:B4").Interior.Color = RGB(255, 255, 179)
        
        
        'Header Boxes on the right
        .Range("D3").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("D3").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("D3:D7").Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("D3:D7").Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("D3:D7").Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("D3:D7").Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        .Range("D7").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("D7").Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("D3:D7").Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
        .Range("D3:D7").Interior.Color = RGB(255, 255, 179)
        
        'First set of data
        .Range("b10:d10").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("b10:d10").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("B10:b" & Firsti + 10).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("B10:b" & Firsti + 10).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("D10:b" & Firsti + 10).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("D10:b" & Firsti + 10).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        .Range("b" & Firsti + 10 & ":D" & Firsti + 10).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("b" & Firsti + 10 & ":D" & Firsti + 10).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("B10:D" & Firsti + 10).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
        .Range("B10:D" & Firsti + 10).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
        .Range("B11:D" & Firsti + 10).Interior.Color = RGB(255, 255, 179)
        
        'Second Set of data
        .Range("B" & Firsti + 13 & ":D" & Firsti + 13).Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 13 & ":D" & Firsti + 13).Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 13 & ":B" & Firsti + 13 + Secondi).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 13 & ":B" & Firsti + 13 + Secondi).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("D" & Firsti + 13 & ":D" & Firsti + 13 + Secondi).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("D" & Firsti + 13 & ":D" & Firsti + 13 + Secondi).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 13 + Secondi & ":D" & Firsti + 13 + Secondi).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 13 + Secondi & ":D" & Firsti + 13 + Secondi).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 13 & ":D" & Firsti + 13 + Secondi).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 13 & ":D" & Firsti + 13 + Secondi).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 14 & ":D" & Firsti + 13 + Secondi).Interior.Color = RGB(255, 255, 179)
        
        'Third Set of data
        .Range("B" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi).Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi).Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 16 + Secondi & ":B" & Firsti + 16 + Secondi + Thirdi).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 16 + Secondi & ":B" & Firsti + 16 + Secondi + Thirdi).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("D" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi + Thirdi).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("D" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi + Thirdi).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 16 + Secondi + Thirdi & ":D" & Firsti + 16 + Secondi + Thirdi).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 16 + Secondi + Thirdi & ":D" & Firsti + 13 + Secondi + Thirdi).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("B" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi + Thirdi).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 16 + Secondi & ":D" & Firsti + 16 + Secondi + Thirdi).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
        .Range("B" & Firsti + 17 + Secondi & ":D" & Firsti + 16 + Secondi + Thirdi).Interior.Color = RGB(255, 255, 179)
  
        'Border Around the outside of everything
        .Range("A1:E1").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
        .Range("A1:E1").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
        .Range("A1:A" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
        .Range("A1:A" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
        .Range("A" & Firsti + Secondi + Thirdi + 18 & ":E" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range("A" & Firsti + Secondi + Thirdi + 18 & ":E" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
        .Range("E1:E" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
        .Range("E1:E" & Firsti + Secondi + Thirdi + 18).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
        
    End With
    
SubExit:
    DoCmd.Hourglass False
    xlApp.Visible = True
    rs1.Close
    Set rs1 = Nothing
    Exit Sub

mafhobb

 

[mafhobb]

Sneuberg,

I ended up doing my own code, but I will look at yours right away to see how it could be done differently.

Thanks for all your help!

mafhobb