Form is open, I used combo because it's from all the dates, so you can select a start and finish date
Form is open, I used combo because it's from all the dates, so you can select a start and finish date
How about the underlying query? Can you attach the db here?
Database exceeds the limit, do you know how to reduce it. It's 6,836 KB
take a copy, remove any data not relevant to the problem. Then compact/repair and zip - load the zip filehow to reduce it
Trying upload
I did a work around the problem: Made a Make Table-Query, then another query for the Table and referenced the new query in the Export Code. Works fine. The make table is ran from the Pop-up Form for selecting Start Date and Finish Date. I added the code to the Export code so I only have one button to run it.
Placing the code that I used to export to Excel, I have the sheet formatted to what I need. I got the code from Access Jitsu, the website has a lot of training videos, but I think they left stuff out, like I could never get it to work like the videos, but got it to do what I needed. Thanks everyone for helping.
'Runs make Table-Quary and suppresses UpDate Warnings
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_ReportExpenseRangeDate", acViewNormal, acEdit
DoCmd.SetWarnings True
'All the following code exports to Excel Sheet
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
'Show user work is being performed
DoCmd.Hourglass (True)
'SQL Statement to Retrieve Data from Database (Table or Query)
SQL = "SELECT NoOrder, DateReceipt, Amount, VenderStore, CostCode, Description, Project, ReceiptYN, Explain" & " FROM qry_ExpenseExportExcel " & "ORDER BY DateReceipt "
'Execute Query and Ppopulate Recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If
'BUILD SPREEDSHEET - 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)
Worksheets("Sheet1").PageSetup.Orientation = xlLandscape
'PageSetup.Orientation = xlLandscape
With xlSheet
'Set Excel Sheet Name
.Name = "Credit Card Charges"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 9
'Set Column Widths
.Columns("A").ColumnWidth = 4 'No. Sort Order
.Columns("A").VerticalAlignment = xlVAlignCenter
.Columns("A").HorizontalAlignment = xlCenter
.Columns("B").ColumnWidth = 8 'Date Receipt
.Columns("B").VerticalAlignment = xlVAlignCenter
.Columns("B").HorizontalAlignment = xlCenter
.Columns("C").ColumnWidth = 8 'Amount
.Columns("C").VerticalAlignment = xlVAlignCenter
.Columns("D").ColumnWidth = 35 'Vender
.Columns("D").VerticalAlignment = xlVAlignCenter
.Columns("E").ColumnWidth = 7 'Code
.Columns("E").VerticalAlignment = xlVAlignCenter
.Columns("E").HorizontalAlignment = xlCenter
.Columns("F").ColumnWidth = 50 'Description
.Columns("F").VerticalAlignment = xlVAlignCenter
.Columns("F").WrapText = True
.Columns("G").ColumnWidth = 35 'Project
.Columns("G").VerticalAlignment = xlVAlignCenter
.Columns("G").WrapText = True
.Columns("H").ColumnWidth = 4 'ReceiptYN
.Columns("H").VerticalAlignment = xlVAlignCenter
.Columns("H").HorizontalAlignment = xlCenter
.Columns("I").ColumnWidth = 12 'Explain
.Columns("I").VerticalAlignment = xlVAlignCenter
'Format Columns
'.Columns("A").NumberFormat = "@"
.Columns("B").NumberFormat = "mm/dd/yy"
'.Columns("C").NumberFormat = "$#,##0.00;-$#,##0.00"
'.Columns("D").NumberFormat = "$#,##0.00;-$#,##0.00"
'.Columns("F").NumberFormat = "#,##0.0#%;-#,##0.0#%"
'Build Report Heading formatting
.Range("A1", "I1").Merge
.Range("A1").HorizontalAlignment = xlCenter
.Range("A1").EntireRow.RowHeight = 20
.Range("A1").Cells.Font.Bold = True
.Range("A1").Cells.Font.Name = "Calibri"
.Range("A1").Cells.Font.Size = 14
'Build Report Heading Input
.Range("A1").Value = "Credit Card Report"
'Build Column headings
.Range("A2").Value = "No"
.Range("B2").Value = "Date"
.Range("C2").Value = "Amount"
.Range("D2").Value = "Vender"
.Range("E2").Value = "Code"
.Range("F2").Value = "Description"
.Range("G2").Value = "Project"
.Range("H2").Value = "R-YN"
.Range("I2").Value = "Explain"
'Format Column Headings
.Range("A2:I2").HorizontalAlignment = xlCenter
.Range("A2:I2").Cells.Font.Bold = True
.Range("A2:I2").Interior.Color = RGB(240, 240, 240)
'Provide Initial Value to Row Counter
i = 3 '3 is the third row under the Row Heading, this is were it starts
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("A" & i).Value = Nz(rs1!NoOrder, "")
.Range("B" & i).Value = Nz(rs1!DateReceipt, "")
.Range("C" & i).Value = Nz(rs1!Amount, 0)
.Range("D" & i).Value = Nz(rs1!VenderStore, "")
.Range("E" & i).Value = Nz(rs1!CostCode, "")
.Range("F" & i).Value = Nz(rs1!Description, "")
.Range("G" & i).Value = Nz(rs1!Project, "")
.Range("H" & i).Value = Nz(rs1!ReceiptYN, "")
.Range("I" & i).Value = Nz(rs1!Explain, "")
i = i + 1
rs1.MoveNext
Loop
'Grid-lines
.Range("A2:I2").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range("A2:A" & i).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("A2:I" & i - 1).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("A2:I" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("A2:I" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("A2:I" & i - 1).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
i = i + 2
End With
SubExit:
On Error Resume Next
DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Sub
Glad you got it sorted. I'm finally near a computer so looked at the sample. As I surmised earlier in posts 15 & 17, your error is because qry_ReportExpenseRange references a form that isn't open (pfrm_ExpenseSelectRpt).