PDA

View Full Version : Solved: Loop Skips data



apunc1
12-19-2012, 09:45 AM
Hi. I have the following function below that works as intended except it skips over every other division.
The code is suppose to loop through query3 and for each Division Field, place the corresponding rows in that spreadsheet,next division in a new sheet and name the sheet for the division.
There are 9 divisions (defined in the arrays) but for some reason when I run the function it only gives tabs for divisions 7,K,N,S,W.
does anyone see a problem with the loop?
Thanks.

Function sheets()
Dim sqlString As String
Dim shtArray As Variant
Dim siteArray As Variant
Dim I As Integer

Dim blnExcel As Boolean, blnHeaderRow As Boolean


Dim rstoutput As Recordset

'define excel variables
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object



blncore = True
blnHeaderRow = True

'Create Excel Application
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
'xlx.Visible = False
Set xlw = xlx.Workbooks.Add(1)

siteArray = Array("7", "C", "K", "M", "N", "R", "S", "T", "W", "Z")
shtArray = Array("7", "C", "K", "M", "N", "R", "S", "T", "W", "Z")


For I = 0 To 9
sqlString = "SELECT * FROM Query3 WHERE Division='" & siteArray(I) & "'"

Set rstoutput = CurrentDb.OpenRecordset(sqlString)

Set xls = xlw.Worksheets.Add
'Set xls = xlw.Worksheets(1)
xls.Name = shtArray(I)
xlw.Worksheets(shtArray(I)).Activate

'format columns as text
xlx.Range("A:A").EntireColumn.Select
xlx.Selection.NumberFormat = "@"
xlx.Range("G:G").EntireColumn.Select
xlx.Selection.NumberFormat = "@"


Set xlc = xls.Range("A1") ' this is the first cell into which data go
If blnHeaderRow = True Then
For lngcolumn = 0 To rstoutput.Fields.count - 1
xlc.Offset(0, lngcolumn).Value = rstoutput.Fields(lngcolumn).Name
Next lngcolumn
Set xlc = xlc.Offset(1, 0)
End If

Do While rstoutput.EOF = False
For lngcolumn = 0 To rstoutput.Fields.count - 1
xlc.Offset(0, lngcolumn).Value = rstoutput.Fields(lngcolumn).Value
Next lngcolumn
rstoutput.MoveNext
Set xlc = xlc.Offset(1, 0)
xls.Cells.EntireColumn.Autofit
xls.Cells.EntireRow.Autofit
Loop
I = I + 1
Next
strFileName = "I:\AdHoc2012\Moore, Nancy\test.xlsx"

xlw.SaveAs (strFileName)
xlw.Close

Set xls = Nothing
Set xlw = Nothing
Set xlx = Nothing

rstoutput.Close
Set rstoutput = Nothing
MsgBox "complete"
End Function

apunc1
12-19-2012, 01:14 PM
commenting out this line seemed to fix

I = I + 1