Copying Ado Recordsets from Access Defined worksheets

[syoung4]

Hi can anyone help me. I have an Access Database and need to produce in Excel payment certificates for 22 contracts.

I have tried to define all 22 recordsets and then test each of the recorsets to see if any data is returned.
The problem I have is I dont want to define 22 worksheets for the eventuality that one of the recordsets might return data. I would like to be able to only put data on to worksheets where the recordsets have data and if possible sort worksheet 1,worksheet 2 etc in contract number order.

Here is my code so far.
Private Sub cboExportExcel_Click()
'Const sFile = "S:\Invoicing\Paymentcertificatetmp.xls"
'Screen.MousePointer = vbHourglass
Dim db As DAO.Database
Dim rs As Recordset
Dim qdf As DAO.QueryDef 'new
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim meterReturn As Integer
Dim strsql As String
Dim exSheet As Excel.Worksheet
Dim s1rs As DAO.Recordset
Dim s2rs As DAO.Recordset
Dim s3rs As DAO.Recordset
Dim s4rs As DAO.Recordset
Dim s5rs As DAO.Recordset
Dim s6rs As DAO.Recordset
Dim s7rs As DAO.Recordset
Dim s8rs As DAO.Recordset
Dim s9rs As DAO.Recordset
Dim s10rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim rs4 As DAO.Recordset
Dim rs5 As DAO.Recordset
Dim rs6 As DAO.Recordset
Dim rs7 As DAO.Recordset
Dim rs8 As DAO.Recordset
Dim rs9 As DAO.Recordset
Dim rs10 As DAO.Recordset
Dim rs11 As DAO.Recordset
Dim rs12 As DAO.Recordset
Dim rs13 As DAO.Recordset
Dim rs14 As DAO.Recordset
Dim rs15 As DAO.Recordset
Dim rs16 As DAO.Recordset
Dim rs17 As DAO.Recordset
Dim rs18 As DAO.Recordset
Dim rs19 As DAO.Recordset
Dim rs20 As DAO.Recordset
Dim rs21 As DAO.Recordset
Dim rs22 As DAO.Recordset

'variants to use for formatting loops
Dim NoOfCols As Integer
Dim NoOfRows As Integer

'Iterant for misc loops
Dim i As Integer
Me.logo.SetFocus
DoCmd.RunCommand acCmdCopy

'Start Progress Meter at bottom left of screen
meterReturn = SysCmd(acSysCmdInitMeter, "Generating Excel Please wait process takes about 1 min...", 100)

' Set rs = CurrentDb.OpenRecordset("qryArchivenew ALL Contracts", _
dbOpenSnapshot)

' DoCmd.OpenQuery "qryArchivenew ALL Contracts", acViewNormal
Set db = CurrentDb()

'Setup all 22 Recordsets to see if they have returned any data this week
Set rs1 = db.OpenRecordset("SELECT [ContractName]as Contract,[OrderNumber]as OrderNo,[DepotName],[EstimateNo],[ExchArea],[Description],[Planned]+[DFE] as Qty,[Rate],[Qty]*[Rate] as Total,[organisation] FROM PaymentCertificatetmp where ContractName = '67325712'")
Set rs2 = db.OpenRecordset("SELECT [ContractName]as Contract,[OrderNumber]as OrderNo,DepotName,[EstimateNo],[ExchArea],[Description],[Planned]+[DFE] as Qty,[Rate],[Qty]*[Rate] as Total,[organisation] FROM PaymentCertificatetmp where ContractName = '67325732'")
Set rs3 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583412'")
Set rs4 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583420'")
Set rs5 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583421'")
Set rs6 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583422'")
Set rs7 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583430'")
Set rs8 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583431'")
Set rs9 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583432'")
Set rs10 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '65583442'")
Set rs11 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325710'")
Set rs12 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325711'")
Set rs13 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325712'")
Set rs14 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325720'")
Set rs15 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325721'")
Set rs16 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325722'")
Set rs17 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325730'")
Set rs18 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325731'")
Set rs19 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325732'")
Set rs20 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325740'")
Set rs21 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325741'")
Set rs22 = db.OpenRecordset("SELECT * FROM PaymentCertificatetmp where ContractName = '67325742'")

'THIS AREA TESTS EACH RECORD SET AND SETS THE PREDEFINED VARIABLE WORKSHEET - so far only two Variable Worksheets Defined
'Need to know if their is a better way test recordsets and only put data on to worksheet if their is any data for the week ran.
'ONLY WANT TO PUT DATA ONTO WORKSHEETS FOR RECORDSETS THAT HAVE DATA: EG. IF NO DATA ON FIRST 21 RECORD SETS ONLY PUT DATA ON TO FIRST WORKSHEET.
'IF DATA ON FIRST WORKSHEET PUT DATA ON TO SECOND AND SO ON.

If rs1.RecordCount > 0 Then Set s1rs = rs1 'If recordset1 has data put onto worksheet 1
If rs2.RecordCount > 0 And rs1.RecordCount < 0 Then Set s1rs = rs2 'If recordset2 has data and recordset1 does not put on to sheet1
If rs2.RecordCount > 0 And rs1.RecordCount > 0 Then Set s2rs = rs2 'If recordset2 has data and recordset1 has data put on to sheet2
'If rs2.RecordCount > 0 And rs1.RecordCount < 0 Then Set s1rs = rs2
' If rs3.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs4.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs5.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs6.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs7.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs8.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs9.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs10.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs9.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs11.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount Then GoTo FIRSTSHEETrs1
' If rs12.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs13.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs14.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs15.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs16.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs17.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs18.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 And rs17.RecordCount < 0 Then GoTo FIRSTSHEETrs1
' If rs19.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 And rs17.RecordCount < 0 And rs18.RecordCount < 0 Then GoTo FIRSTSHEETrs1
'If rs20.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 And rs17.RecordCount < 0 And rs18.RecordCount < 0 And rs19.RecordCount < 0 Then GoTo FIRSTSHEETrs1
'If rs21.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 And rs17.RecordCount < 0 And rs18.RecordCount < 0 And rs19.RecordCount < 0 Then GoTo FIRSTSHEETrs1
'If rs22.RecordCount > 0 And rs1.RecordCount < 0 And rs2.RecordCount < 0 And rs3.RecordCount < 0 And rs4.RecordCount < 0 And rs5.RecordCount < 0 And rs6.RecordCount < 0 And rs7.RecordCount < 0 And rs8.RecordCount < 0 And rs9.RecordCount < 0 And rs10.RecordCount < 0 And rs11.RecordCount < 0 And rs12.RecordCount < 0 And rs13.RecordCount < 0 And rs14.RecordCount < 0 And rs15.RecordCount < 0 And rs16.RecordCount < 0 And rs17.RecordCount < 0 And rs18.RecordCount < 0 And rs19.RecordCount < 0 And rs20.RecordCount < 0 And rs21.RecordCount < 0 Then GoTo FIRSTSHEETrs1
FIRSTSHEETrs1:
intMaxCol = s1rs.Fields.Count
If s1rs.RecordCount > 0 Then
s1rs.MoveLast: s1rs.MoveFirst
intMaxRow = s1rs.RecordCount

Set objXL = New Excel.Application
With objXL
.Visible = True
Set objWkb = .Workbooks.add
Set objSht = objWkb.Worksheets(1)
'Select the first worksheet
.Sheets("Sheet1").Select
.Range("f1").PasteSpecial xlPasteAll
.Range("a1").Select
.Selection.RowHeight = 65
.ActiveSheet.Shapes("Picture 1").Select
.Selection.ShapeRange.IncrementLeft 0.75
.Selection.ShapeRange.IncrementTop 16.5
.Range("a2").Value = "Payment Certificate "
.Range("a2").Font.Bold = True
.Range("a2").Font.Name = "Arial"
.Range("a2").Font.Size = 12
.Range("a3").Value = "Subcontractor: " & rs1("organisation")
.Range("a3").Font.Bold = True
.Range("a3").Font.Name = "Arial"
.Range("a3").Font.Size = 12
.Range("h2").Value = "Week Ending: " & "Tbe"
.Range("h2").Font.Name = "Ariel"
.Range("h2").Font.Size = 12
.Range("h2").Font.Bold = True
.Range("h3").Value = "Purchase Order: " & "Tbe"
.Range("h3").Font.Name = "Ariel"
.Range("h3").Font.Size = 12
.Range("h3").Font.Bold = True
.ActiveWindow.Zoom = 95
.Range("A5").Select
'.Columns.EntireColumn.AutoFit
.Columns("A:A").Select
.Selection.ColumnWidth = 9.5
.Columns("B:B").Select
.Selection.ColumnWidth = 12
.Columns("C:C").Select
.Selection.ColumnWidth = 11
.Columns("D").Select
.Selection.ColumnWidth = 12
.Columns("E:E").Select
.Selection.ColumnWidth = 16
.Columns("F:F").Select
.Selection.ColumnWidth = 62.67
.Columns("G:G").Select
.Selection.ColumnWidth = 4.83
.Columns("H:H").Select
.Selection.ColumnWidth = 11
.Columns("I:I").Select
.Selection.ColumnWidth = 11
.Columns("J:J").Select
.Selection.ColumnWidth = 11
.Columns("H:I").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
.Range("A4:J4").Select
.Selection.Font.Bold = True
.Columns("A:J").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
.Range("A2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A4").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select
'Populate the variables
NoOfCols = s1rs.Fields.Count
'Write in the column headings
For i = 0 To NoOfCols - 1
.Cells(4, i + 1).Value = s1rs.Fields(i).Name
Next i
'This section copies the data from the recordset to the range of cells specified eg row 10 col 1
.Range(.Cells(5, 1), .Cells(intMaxRow, _
intMaxCol)).CopyFromRecordset s1rs
'Use our variables to format the data populated cells ONLY
' .Range("A1", ExcelCodes(NoOfCols) & 1).Interior.Color = vbYellow
' .Columns.EntireColumn.AutoFit
'And again - using both this time
' .Range("A1", ExcelCodes(NoOfCols) & (NoOfRows + 1)).Borders.Color = RGB(0, 0, 0)
'Adjust column widths
'.Columns.EntireColumn.AutoFit

'----------------------------------------------------------------
SECONDSHEETrs2:
intMaxCol = s2rs.Fields.Count
If s2rs.RecordCount > 0 Then
s2rs.MoveLast: s2rs.MoveFirst
intMaxRow = s2rs.RecordCount
.Sheets.add
' .Sheets.add After:=Sheets(1)
'Select the Second worksheet
'.Sheets.add
.Sheets("Sheet2").Select
.Range("f1").PasteSpecial xlPasteAll
.Range("a1").Select
.Selection.RowHeight = 65
.ActiveSheet.Shapes("Picture 1").Select
.Selection.ShapeRange.IncrementLeft 0.75
.Selection.ShapeRange.IncrementTop 16.5
.Range("a2").Value = "Payment Certificate "
.Range("a2").Font.Bold = True
.Range("a2").Font.Name = "Arial"
.Range("a2").Font.Size = 12
.Range("a3").Value = "Subcontractor: " & s2rs("organisation")
.Range("a3").Font.Bold = True
.Range("a3").Font.Name = "Arial"
.Range("a3").Font.Size = 12
.Range("h2").Value = "Week Ending: " & "Tbe"
.Range("h2").Font.Name = "Ariel"
.Range("h2").Font.Size = 12
.Range("h2").Font.Bold = True
.Range("h3").Value = "Purchase Order: " & "Tbe"
.Range("h3").Font.Name = "Ariel"
.Range("h3").Font.Size = 12
.Range("h3").Font.Bold = True
.ActiveWindow.Zoom = 95
.Range("A5").Select
'.Columns.EntireColumn.AutoFit
.Columns("A:A").Select
.Selection.ColumnWidth = 9.5
.Columns("B:B").Select
.Selection.ColumnWidth = 12
.Columns("C:C").Select
.Selection.ColumnWidth = 11
.Columns("D").Select
.Selection.ColumnWidth = 12
.Columns("E:E").Select
.Selection.ColumnWidth = 16
.Columns("F:F").Select
.Selection.ColumnWidth = 62.67
.Columns("G:G").Select
Selection.ColumnWidth = 4.83
.Columns("H:H").Select
Selection.ColumnWidth = 11
.Columns("I:I").Select
Selection.ColumnWidth = 11
.Columns("J:J").Select
.Selection.ColumnWidth = 11
.Columns("H:I").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
.Range("A4:J4").Select
.Selection.Font.Bold = True
.Selection.Font.Bold = True
.Columns("A:J").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A4").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select


'Populate the variables
NoOfCols = s2rs.Fields.Count
'Write in the column headings
For i = 0 To NoOfCols - 1
.Cells(4, i + 1).Value = s2rs.Fields(i).Name
Next i
'This section copies the data from the recordset to the range of cells specified eg row 10 col 1
.Range(.Cells(5, 1), .Cells(intMaxRow, _
intMaxCol)).CopyFromRecordset s2rs
'Use our variables to format the data populated cells ONLY
'.Range("A1", ExcelCodes(NoOfCols) & 1).Interior.Color = vbYellow
'.Columns.EntireColumn.AutoFit
'And again - using both this time
' .Range("A1", ExcelCodes(NoOfCols) & (NoOfRows + 1)).Borders.Color = RGB(0, 0, 0)
'Adjust column widths
' .Columns.EntireColumn.AutoFit

End If


'Turn the Progress meter off
meterReturn = SysCmd(acSysCmdRemoveMeter)
Me.cboExportExcel.SetFocus
End With
End If
End Sub

 

[easyit]

Hi,

i see a lot of repetition. You should consider creating loops, which will make your code less ugly and better to read and understand. Also, this will prevent you from changing your code again if there are contract numbers added ore removed.


But beside that, it seems to me you are better of designing a (only one - and in the qbe pane!) query that gives back all the records that should go into separate excel sheets.
After that, you can modify the sql of this query through VBA to export the needed data.

After you have that working, you can focus on formatting the sheets - there are several options (use preformatted template, format from MsAccess VBA, start VBA code in the excel sheets from MsAccess VBA etc.)

Q: What defines the selection of the contract numbers? Are they random numbers or is it something else?


EasyIT

 

[syoung4]

Thank you for your reply. I have all the data in an Access 97 Database it would be easy just to send out an Access report that puts all the data on to the correct pages. I have to send out the certificates each week in Excel format so that they can be reconciled and modified at head office. I will not know what data has been sent in to the girls for booking into a finance system when I send out the certificates for payment on tuesdays. I know there are 22 posible contracts.

I am just trying to get the data from access the same as an access report on to excel. But up to now I feel I am getting nowhere. My query that produces the reports is huge. I am using passthrough to speed up the query as it has to tie up a lot of different aspects of payments.

I Use a form with drop down parameters that supply a template sql passthrough query and overtype the variable parameters in the copied query that produces all the figures.

I need to have an open save api to save the report straight from the access menu to Excel.

We have a system like this already but it is compiled.
It takes a day to produce 22 reports and format them from this system as they all have to have work order numbers added to them manualy.

I am trying to make the system more automatic and do this for me.

This is my Access Query.
That works ok and gets the right data.

SELECT tblClient.ClientID, tblContract.ContractName,tblContract.ContractName AS [AssociatedContract], 0 AS Zerotransferitem, tblDepot.DepotName,
tblFinPayments.OrderNumber,tblA537.EstOrdNo AS EstimateNo, tblA537.ExchArea, tblFinPaymentDetail.WorkItem AS RateCode,
tblWorkItemContract.Description,tblFinWorkItemRate.Rate, tblFinPaymentDetail.Planned, tblFinPaymentDetail.DFE,
tblFinWeekEndingOrganisations.organisation, 0 AS WEEKID
FROM ((((((((tblFinPayments
INNER JOIN tblFinPaymentDetail ON tblFinPayments.PaymentID = tblFinPaymentDetail.PaymentID)
INNER JOIN tblFinOperativeItems ON tblFinPayments.PaymentID = tblFinOperativeItems.PaymentId)
INNER JOIN tblFinWorkItemRate ON tblFinWorkItemRate.RatePatchID = tblFinOperativeItems.RatePatch)
INNER JOIN tblFinWeekEnding ON tblFinPayments.WeekEndID = tblFinWeekEnding.WeekEndID)
INNER JOIN tblFinWeekEndingOrganisations ON tblFinWeekEnding.organisationID = tblFinWeekEndingOrganisations.organisationID)
INNER JOIN tblA537 ON tblFinPayments.OrderNumber = tblA537.OrderNumber)
INNER JOIN tblContract ON tblContract.ContractID = tblA537.ContractID)
INNER JOIN tblClient ON tblClient.ClientID = tblContract.ClientID)
INNER JOIN tblWorkItemContract ON tblFinPaymentDetail.WorkItem = tblWorkItemContract.NIMSID
INNER JOIN tblDepot ON tblA537.DepotID = tblDepot.DepotID
WHERE (((tblFinPayments.WeekEndId)= 'myWkEnd1'))
AND ((tblFinWeekEnding.organisationID)= 'myOrganisationID1')
AND ((tblFinPaymentDetail.WorkItem)=(SELECT NIMSID From tblWorkItemContract where ItemID= tblFinWorkItemRate.ItemID))
AND ((tblFinWorkItemRate.ItemID = tblWorkItemContract.ItemID)
AND ((tblA537.DepotID) Between (SELECT TOP 1 tblA537.DepotID from tblA537) And [tblA537].[DepotID])
AND (((tblClient.ClientID) Between [tblClient].[ClientID] And (SELECT TOP 1 tblClient.ClientID from tblClient))
AND (((tblContract.ContractID) Between (SELECT TOP 1 tblContract.ContractID from tblContract) And [tblContract].[ContractID]))
AND ((tblWorkItemContract.ItemID) Not Like ('z%%'))))
UNION ALL
SELECT tblClient.ClientID, tblContract.ContractName, tblContract.ContractName AS [AssociatedContract],
0 AS Zerotransferitem, tblDepot.DepotName, tblFinPayments.OrderNumber, tblA537.EstOrdNo AS EstimateNo,
tblA537.ExchArea,tblFinPaymentDetail.WorkItem AS RateCode, tblFinWorkItemRateSplit.Description,
tblFinWorkItemRateSplit.Rate,tblFinPaymentDetail.Planned, tblFinPaymentDetail.DFE, tblFinWeekEndingOrganisations.organisation, 0 AS
WeekID
FROM ((((((((tblFinPayments
INNER JOIN tblFinPaymentDetail ON tblFinPayments.PaymentID = tblFinPaymentDetail.PaymentID)
INNER JOIN tblFinOperativeItems ON tblFinPayments.PaymentID = tblFinOperativeItems.PaymentId)
INNER JOIN tblFinWorkItemRateSplit ON tblFinWorkItemRateSplit.RatePatchID = tblFinOperativeItems.RatePatch)
INNER JOIN tblFinWeekEnding ON tblFinPayments.WeekEndID = tblFinWeekEnding.WeekEndID)
INNER JOIN tblFinWeekEndingOrganisations ON tblFinWeekEnding.organisationID = tblFinWeekEndingOrganisations.organisationID)
INNER JOIN tblA537 ON tblFinPayments.OrderNumber = tblA537.OrderNumber)
INNER JOIN tblContract ON tblContract.ContractID = tblA537.ContractID)
INNER JOIN tblClient ON tblClient.ClientID = tblContract.ClientID)
INNER JOIN tblDepot ON tblA537.DepotID = tblDepot.DepotID
WHERE (((tblFinPayments.WeekEndId)= 'myWkEnd2'))
AND ((tblFinWeekEnding.organisationID)= 'myOrganisationID2')
AND ((tblFinPaymentDetail.WorkItem = tblFinWorkItemRateSplit.WorkItem)
AND ((tblA537.DepotID) Between (SELECT TOP 1 tblA537.DepotID from tblA537) And [tblA537].[DepotID])
AND (((tblClient.ClientID) Between [tblClient].[ClientID] And (SELECT TOP 1 tblClient.ClientID From tblClient))
AND (((tblContract.ContractID) Between (SELECT TOP 1 tblContract.ContractID from tblContract) And [tblContract].[ContractID]))
AND ((tblFinWorkItemRateSplit.ParentItemID) Not Like ('z%%'))))
UNION ALL
SELECT tblClient.ClientID, tblContract.ContractName,tblContract.ContractName AS [AssociatedContract], 0 AS Zerotransferitem, tblDepot.DepotName,
tblFinPayments.OrderNumber,tblA537.EstOrdNo AS EstimateNo, tblA537.ExchArea, tblFinPaymentDetail.WorkItem AS RateCode,
tblWorkItemContract.Description,tblFinWorkItemRate.Rate, tblFinPaymentDetail.Planned, tblFinPaymentDetail.DFE,
tblFinWeekEndingOrganisations.organisation, 0 AS WEEKID
FROM ((((((((tblFinPayments
INNER JOIN tblFinPaymentDetail ON tblFinPayments.PaymentID = tblFinPaymentDetail.PaymentID)
INNER JOIN tblFinOperativeItems ON tblFinPayments.PaymentID = tblFinOperativeItems.PaymentId)
INNER JOIN tblFinWorkItemRate ON tblFinWorkItemRate.RatePatchID = tblFinOperativeItems.RatePatch)
INNER JOIN tblFinWeekEnding ON tblFinPayments.WeekEndID = tblFinWeekEnding.WeekEndID)
INNER JOIN tblFinWeekEndingOrganisations ON tblFinWeekEnding.organisationID = tblFinWeekEndingOrganisations.organisationID)
INNER JOIN tblA537 ON tblFinPayments.OrderNumber = tblA537.OrderNumber)
INNER JOIN tblContract ON tblContract.ContractID = tblA537.ContractID)
INNER JOIN tblClient ON tblClient.ClientID = tblContract.ClientID)
INNER JOIN tblWorkItemContract ON tblFinPaymentDetail.WorkItem = tblWorkItemContract.NIMSID
INNER JOIN tblDepot ON tblA537.DepotID = tblDepot.DepotID
INNER JOIN tblWorkStream ON tblContract.WorkstreamID = tblWorkStream.WorkstreamID
WHERE (((tblFinPayments.WeekEndId)= 'myWkEnd3'))
AND ((tblFinWeekEnding.organisationID)= 'myOrganisationID3')
AND ((tblFinPaymentDetail.WorkItem)=(SELECT NIMSID From tblWorkItemContract where ItemID= tblFinWorkItemRate.ItemID))
AND((tblFinWorkItemRate.ItemID = tblWorkItemContract.ItemID))
AND ((tblA537.DepotID) Between (SELECT TOP 1 tblA537.DepotID from tblA537) And [tblA537].[DepotID])
AND (((tblClient.ClientID) Between [tblClient].[ClientID] And (SELECT TOP 1 tblClient.ClientID from tblClient))
AND (((tblContract.ContractID) Between (SELECT TOP 1 tblContract.ContractID from tblContract) And [tblContract].[ContractID]))
AND ((tblWorkItemContract.ItemID) Not Like ('z%%'))
AND ((tblWorkStream.WorkStreamName = 'Civil')))
UNION ALL
SELECT tblClient.ClientID, tblContract.ContractName,tblContract.ContractName AS [AssociatedContract], 0 AS Zerotransferitem, tblDepot.DepotName,
tblFinPayments.OrderNumber,tblA537.EstOrdNo AS EstimateNo, tblA537.ExchArea, tblFinPaymentDetail.WorkItem AS RateCode,
tblWorkItemContract.Description,tblFinWorkItemRate.Rate, tblFinPaymentDetail.Planned, tblFinPaymentDetail.DFE,
tblFinWeekEndingOrganisations.organisation, 0 AS WEEKID
FROM ((((((((tblFinPayments
INNER JOIN tblFinPaymentDetail ON tblFinPayments.PaymentID = tblFinPaymentDetail.PaymentID)
INNER JOIN tblFinOperativeItems ON tblFinPayments.PaymentID = tblFinOperativeItems.PaymentId)
INNER JOIN tblFinWorkItemRate ON tblFinWorkItemRate.RatePatchID = tblFinOperativeItems.RatePatch)
INNER JOIN tblFinWeekEnding ON tblFinPayments.WeekEndID = tblFinWeekEnding.WeekEndID)
INNER JOIN tblFinWeekEndingOrganisations ON tblFinWeekEnding.organisationID = tblFinWeekEndingOrganisations.organisationID)
INNER JOIN tblA537 ON tblFinPayments.OrderNumber = tblA537.OrderNumber)
INNER JOIN tblContract ON tblContract.ContractID = tblA537.ContractID)
INNER JOIN tblClient ON tblClient.ClientID = tblContract.ClientID)
INNER JOIN tblWorkItemContract ON tblFinPaymentDetail.WorkItem = tblWorkItemContract.NIMSID
INNER JOIN tblDepot ON tblA537.DepotID = tblDepot.DepotID
INNER JOIN tblWorkStream ON tblContract.WorkstreamID = tblWorkStream.WorkstreamID
WHERE (((tblFinPayments.WeekEndId)= 'myWkEnd4'))
AND ((tblFinWeekEnding.organisationID)= 'myOrganisationID4')
AND ((tblFinPaymentDetail.WorkItem)=(SELECT NIMSID From tblWorkItemContract where ItemID= tblFinWorkItemRate.ItemID))
AND((tblFinWorkItemRate.ItemID = tblWorkItemContract.ItemID))
AND ((tblA537.DepotID) Between (SELECT TOP 1 tblA537.DepotID from tblA537) And [tblA537].[DepotID])
AND (((tblClient.ClientID) Between [tblClient].[ClientID] And (SELECT TOP 1 tblClient.ClientID from tblClient))
AND (((tblContract.ContractID) Between (SELECT TOP 1 tblContract.ContractID from tblContract) And [tblContract].[ContractID]))
AND ((tblWorkItemContract.ItemID) Not Like ('z%%'))
AND ((tblWorkStream.WorkStreamName = 'Cable')))
ORDER BY tblContract.ContractName,ZeroTransferItem,tblFinPayments.OrderNumber,tblFinPaymentDetail.WorkItem


Most of the information on getting access to excel just does not go this far.

Regards,

Sid

 

[syoung4]

I forgot to say the criteria for selecting the Certificates each week is the Week Ending Thursdays.
and The Organisation name which is the suppliers name.

This is supplied through my form.
which also makes a table from the data where I am trying to get the output to exel from called "PaymentCertificatetmp"

Regards,
Sid

 

[easyit]

ouch, a lot of text!

Could you tell me how many tables there are, how big they are? How big is your DB?

EasyIT