What I am doing is I've created a vb program that has a button that executes a module I've created. This module retrieves data from my MS SQL Server database (From multiple tables) and then writes the records to an existing excel file and then displays the excel file. For formatting purposes I need to write to each cell. Everything works fine except that it takes forever to load the excel file with the data from the database. Any help or feedback would be appreciated.

'Here is my code:

Public Sub CityListExcel()

Dim localID As Integer
Dim i As Integer
Dim y As Integer
Dim Password, User, InitialC, Source
Dim xlApp As excel.Application
Dim xlbook As excel.Workbook
Dim xlsheet As excel.Worksheet
Dim t As Integer
Dim cnn1 As ADODB.Connection
Dim rs As ADODB.Recordset

localID = OrderID

Source = "LUKE\LUKE"
User = ""
Password = ""
InitialC = "OfficeDev"

Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;Trusted_Connection=yes;Password=" & Password & ";User ID=" & User & ";Initial Catalog=" & InitialC & ";Data Source=" & Source
cnn1.Open
Set rs = cnn1.Execute("SELECT PRODUCTS.*, UNITS.*, STATE.* FROM PRODUCTS, UNITS, STATE WHERE PRODUCTS.ProductType_ID = " & 1 & " AND PRODUCTS.Units_ID = UNITS.Units_ID AND PRODUCTS.State_ID = STATE.State_ID ORDER BY PRODUCTS.Product_Name")

Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Open(App.Path & "\Templates\CityList.xls")
Set xlsheet = xlbook.Worksheets("City List Only")
xlsheet.Activate
xlbook.Application.Visible = False
xlApp.Application.Visible = False
xlApp.ScreenUpdating = False
y = 1
i = 3

Do While Not rs.EOF

If i < 58 Then

xlsheet.Cells(i, y) = rs!Updates
y = y + 1
xlsheet.Cells(i, y) = rs!Product_Name
y = y + 1
xlsheet.Cells(i, y) = rs!ProductDate
y = y + 1
xlsheet.Cells(i, y) = rs!Datum
y = y + 1
xlsheet.Cells(i, y) = rs!Projection
y = y + 1
xlsheet.Cells(i, y) = rs!Units_Name
y = y + 1
xlsheet.Cells(i, y) = rs!SquareMiles
y = y + 1
xlsheet.Cells(i, y) = rs!Resolution
y = 1

i = i + 1

End If

rs.MoveNext
Loop
rs.Close
cnn1.Close

Set rs = Nothing
xlbook.Application.Visible = True
xlApp.ScreenUpdating = True

End Sub