Export Loop from Access to Excel to multiple columns

[claven123]

Dim i As Integer
i = 9
with xlWks
   Do While Not rsCmtJaws.EOF
       .Range("Y" & i).Value = Nz(rsCmtJaws!FullName, "")
      i = i + 1
   rsCmtJaws.MoveNext
   Loop
End With

I'm trying to do the same thing as above BUT move the loop over a few columns each time is finds a record.

ie I want the FullName to be in column Y then K, T, AC and AL

I've played around with this and it just doesn't work.

D

 

[Sektor]

You need to use Cells rather Range because its second arguments accepts columns as indexes (numbers).

 

[claven123]

I'm not sure how to do that, will have to look that up.

Thanks,

D

 

[claven123]

I've got it to work, now will have to get the loop to go to the next columns. It just send the first name to cell K9

Private Sub CmdOpenJawsInsp1206_Click()
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim SQLCmtJaws As String
Dim SQLCmtJawsChair As String
Dim rsCmtJaws As DAO.Recordset
Dim rsCmtJawsChair As DAO.Recordset
SQLCmtJaws = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJaws, TblMembers.CmtJawsChair " & _
    " FROM TblMembers " & _
    " WHERE (((TblMembers.CmtJaws)=True)) And ((TblMembers.CmtJawsChair) = No)"
SQLCmtJawsChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJawsChair " & _
    " FROM TblMembers " & _
    " WHERE (((TblMembers.CmtJawsChair)=True))"
Set rsCmtJaws = CurrentDb.OpenRecordset(SQLCmtJaws, dbOpenSnapshot)
Set rsCmtJawsChair = CurrentDb.OpenRecordset(SQLCmtJawsChair, dbOpenSnapshot)
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(CurrentProject.Path & "\Master\Jaws_Insp_1206.xlsx")
Set xlWks = xlWkb.Sheets("Oct")
xlApp.Visible = True
With xlWks
    Do While Not rsCmtJawsChair.EOF
        .Range("B9").Value = (rsCmtJawsChair!FullName)
        rsCmtJawsChair.MoveNext
    Loop
End With
With xlWks
    Do While Not rsCmtJaws.EOF
        .Cells(9, 11).Value = Nz(rsCmtJaws!FullName, "")
        rsCmtJaws.MoveNext
    Loop
End With
SubExit:
On Error Resume Next
rsCmtJaws.Close
rsCmtJawsChair.Close
Set rsCmtJaws = Nothing
Set rsCmtJawsChair = Nothing
Exit Sub

 

[Sektor]

Well, in the loop you could change the second argument (column) to the one you need. Since your columns don't have same "distance" between them (i.e. it's impossible to set the same step, or increment), you have to create your own array, fill it with column's indexes and in that loop retrieve them. Here's example:

Sub F()
    Dim arr, i
    arr = VBA.Array(5, 12, 22)
    i = -1
    Do While Not rsCmtJaws.EOF
        i = i+1
        .Cells(9, arr(i)).Value = Nz(rsCmtJaws!FullName, "")
        rsCmtJaws.MoveNext
    Loop
End Sub

 

[claven123]

This ended up working, I had to offset the columns by 9 to get what I needed, thanks for the pointer to the solution.

d

Private Sub CmdOpenJawsInsp1206_Click()
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim i As Integer
Dim SQLCmtJaws As String
Dim SQLCmtJawsChair As String
Dim rsCmtJaws As DAO.Recordset
Dim rsCmtJawsChair As DAO.Recordset
SQLCmtJaws = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJaws, TblMembers.CmtJawsChair " & _
    " FROM TblMembers " & _
    " WHERE (((TblMembers.CmtJaws)=True)) And ((TblMembers.CmtJawsChair) = No)"
SQLCmtJawsChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJawsChair " & _
    " FROM TblMembers " & _
    " WHERE (((TblMembers.CmtJawsChair)=True))"
Set rsCmtJaws = CurrentDb.OpenRecordset(SQLCmtJaws, dbOpenSnapshot)
Set rsCmtJawsChair = CurrentDb.OpenRecordset(SQLCmtJawsChair, dbOpenSnapshot)
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(CurrentProject.Path & "\Master\Jaws_Insp_1206.xlsx")
Set xlWks = xlWkb.Sheets("Oct")
xlApp.Visible = True
With xlWks
    Do While Not rsCmtJawsChair.EOF
        .Range("B9").Value = (rsCmtJawsChair!FullName)
        rsCmtJawsChair.MoveNext
    Loop
End With
With xlWks
    Do While Not rsCmtJaws.EOF
        .Cells(9, 11 + i).Value = Nz(rsCmtJaws!FullName, "")
        i = i + 9
        rsCmtJaws.MoveNext
    Loop
End With
SubExit:
On Error Resume Next
rsCmtJaws.Close
rsCmtJawsChair.Close
Set rsCmtJaws = Nothing
Set rsCmtJawsChair = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "=" & Err.Description, vbCritical + vbOKOnly, "An error occured"
 GoTo SubExit
End Sub

 

[Sektor]