-1 returned as last record of recordset object

[Anthony]

Hey All,

I'm using a DAO.recordset object to retrieve info from an access DB, and
when I transpose the records onto my Excel workbook, the final record ends
up with the "absolute position" indicator of -1, hence, when i try to
extract any data from said record, I get a "Run Time Error 1004: No Current
Record". I've never used "application.transpose" before, but short of going
column by column, I couldn't find any other way to copy/paste the data one
record at a time. There are too many columns in each record to do it
column-by-column.

In case it helps, here's the code I'm using--I'm basically doing a query and
then running a subquery based on one piece of criteria from each row of the
initial query (if that all made sense). The really strange thing is that
the 2nd query, which is supposed to be based on 1 column ("Val1") from each
row of the 1st query actually shows up *before* the data from the first
query on the worksheet. I'm at a loss.

Things commented out were failed troubleshooting attempts.

Code:
Sub compileData2()
Dim db1 As DAO.Database
Dim rs1 As DAO.Recordset
Dim strSQL1 As String
Dim rs2 As DAO.Recordset
Dim strSQL2 As String
Dim strCircNum As String
Dim strPath As String
Dim strRow As String
Dim array1 As Variant
Dim array2 As Variant
Dim x As Long
Dim y As Long
Dim z As Long

'Select the source database path from the Interface worksheet
Sheets("Interface").Select
strPath = Range("B3").Value

'Assign Path to db1
Set db1 = OpenDatabase(strPath, , True)

strSQL1 = "SELECT * FROM qryNumber1"
Set rs1 = db1.OpenRecordset(strSQL1, dbOpenSnapshot, dbReadOnly, dbReadOnly)

If rs1.EOF And rs1.BOF Then
Exit Sub
End If

rs1.MoveLast
MsgBox rs1.RecordCount, vbOKOnly

'Clear data on current worksheet
With Worksheets("testsheet")
.Rows("5:65536").Delete
End With


'Value in Frame/T1 Array
x = 1

'Current Row in Destination worksheet
y = 5

rs1.MoveFirst
Do While Not rs1.EOF
'Debug.Print rs1("CircuitID").Value & vbCrLf
array1 = rs1.GetRows

'Copy headers
Sheets("Interface").Select
Rows("32:32").Select
Selection.Copy

'Paste headers
Sheets("Testsheet").Select
Rows(y).Select
ActiveSheet.Paste

y = y + 1

With Worksheets("testsheet")
.Range("A" & y & ":Z" & y).Value = Application.Transpose(array1)
'.Select
'y = y + 1
'.Range("A" & y & ":A" & y).Value = rs1.AbsolutePosition
'.Range("B" & y & ":B" & y).Value = rs1("Val1")
End With

If IsNull(rs1("Val1").Value) = False Then
strCircNum = rs1("Val1").Value

strSQL2 = "SELECT * FROM qryNumber2 WHERE Val1 in ('" & strCircNum &
"')"
Set rs2 = db1.OpenRecordset(strSQL2, dbOpenSnapshot, dbReadOnly,
dbReadOnly)

If rs2.BOF And rs2.EOF Then
'MsgBox "No records were returned.", vbOKOnly
GoTo NoCircDetail
Else
y = y + 1
z = 1
rs2.MoveFirst
Do While Not rs2.EOF
strRow = rs2(2).Value & " " & rs2(1).Value & " " &
rs2(3).Value & " " & rs2(4).Value
array2 = rs2.GetRows(z)
With Worksheets("testsheet")
.Range("B" & y & ":F" & y).Value =
Application.Transpose(array2)
'.Select
End With
'Debug.Print strRow
'rs2.MoveNext
y = y + 1
Loop
'End With
End If
End If

NoCircDetail:
' rs1.MoveNext
'x = x + 1
y = y + 1
Loop

ExitProcess:
rs1.Close
rs2.Close
Set rs1 = Nothing
Set rs2 = Nothing
Set db1 = Nothing
Exit Sub

End Sub

 

[onedaywhen]

I'm using a DAO.recordset object to retrieve info

Any reason why you are not using CopyFromRecordset? e.g.

Worksheets("testsheet").Range("A2").CopyFromRecordset rs1

--