Access VBA code efficiency required....

[narendertangutooei]

dear mates,

am new to MS ACCESS .
can any one help me on the below code without any performance issues.



Private Sub cmdchemicalcompareexport_Click()
Dim saveloc As String
strWorksheetPath As String
xl As Object
wb As Object
Dim exportsheet As Object
Dim index As Long
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
Dim rng As Object


Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Add
Set exportsheet = wb.Worksheets(1)
exportsheet.Name = "Chemical Compare"
xl.Application.Visible = True
Set rs = db.OpenRecordset(Me.RecordSource)



exportsheet.Cells(3, 1).Value = "Trade Name"
exportsheet.Cells(4, 1).Value = "Supplier"
exportsheet.Cells(5, 1).Value = "Category"
exportsheet.Cells(6, 1).Value = "Physical Appearance"
exportsheet.Cells(7, 1).Value = "Active Ingredient"
exportsheet.Cells(8, 1).Value = "Regional Availability"
exportsheet.Cells(9, 1).Value = "EPA#"
exportsheet.Cells(10, 1).Value = "Comment"
exportsheet.Range("A3:A10").Font.Bold = True



Dim rownum As Long, colnum As Long
Dim i As Long
i = 0
rownum = 3
colnum = 2
rs.MoveFirst


For index = 1 To rs.Fields.Count
If rs.Fields(i).Name <> "SDS" And rs.Fields(i).Name <> "CID" Then
Do While Not rs.EOF
exportsheet.Cells(rownum, colnum).Value = rs.Fields(i).Value
rs.MoveNext
colnum = colnum + 1


Loop
rownum = rownum + 1
colnum = 2


End If
i = i + 1
rs.MoveFirst
Next
Set rng = exportsheet.UsedRange
rng.Borders.LineStyle = xlContinuous
exportsheet.Cells.EntireColumn.AutoFit
exportsheet.Cells.EntireColumn.HorizontalAlignment = xlLeft

'build report heading
exportsheet.Range("A1", "F1").Merge
exportsheet.Range("A2", "F2").Merge
exportsheet.Range("A1").HorizontalAlignment = xlCenter
exportsheet.Range("A2").HorizontalAlignment = xlCenter
exportsheet.Range("A1").Cells.Font.Bold = True
exportsheet.Range("A2").Cells.Font.Bold = True
exportsheet.Range("A1").Cells.Font.Name = "Cambria"
exportsheet.Range("A2").Cells.Font.Name = "Cambria"
exportsheet.Range("A1").Cells.Font.Size = 14
exportsheet.Range("A2").Cells.Font.Size = 12
exportsheet.Range("A1").Value = "Report Chemical Comparision "
exportsheet.Range("A2").Value = Date & " " & Time


End Sub

[Minty]

I would use the inbuilt access export function (DoCmd.TransferSpreadsheet) then apply your formatting.
It will be much quicker than looping through the recordset.