Array resizing help

[JKwan]

I am having a slight issue with resizing an array of data to my spreadsheet, hopefully someone can help. I use below code to write it to the sheet and it works

            objRec = objRecordSet.GetRows


            For r = LBound(objRec, 2) To UBound(objRec, 2)
                For c = LBound(objRec, 1) To UBound(objRec, 1)
                    .Cells(r + 2, c + 1) = objRec(c, r)
                Next c
            Next r

now I am trying to use Resize and that is where the fun begins, I have below function (thought it would work, but does not)

Sub WriteArrayToSheet(vArray As Variant, StartAt As String, _                      Optional bTranspose As Boolean = False)
    With Range(StartAt)
        Select Case bTranspose
            Case True
                .Resize(UBound(vArray, 2), _
                        UBound(vArray, 1)).Value = Application.Transpose(vArray)
        
            Case False
                .Resize(UBound(vArray, 1), _
                        UBound(vArray, 2)).Value = vArray
                
        End Select
    End With
End Sub

when i pass my array into the sub (without transposing it - it propagate across the columns), not what I want (works). I wanted the array to go down in rows. I set my bTranspose to true but I get an error??? What may be wrong with the transposing??

[mikerickson]

Have you tried code like this instead of looping for the first bit of code?

Range("A1").Resize(UBound(objRec,2), Ubound(objRec,1).Value = Application.Transpose(objRec)

[mikerickson]

What error do you get when bTranspose is True?

[JKwan]

Thanks for the response. I used what you had on post #2, I got the same error Type Mismatch (Error 13)

[mikerickson]

The type mismatch error suggests that you aren't passing an array of values to the WriteArrayToSheet sub.

I'm also concerned about the obj in objRec. Does that mean that objRec is an array of objects. If so, your first code may be surviving because of a default property, but it can't be done in bulk.

I also noticed the line

objRec = objRecordSet.GetRows

The ObjectBrowser lists no native Excel object that has a GetRows property. Is objRecordSet a member of a custom Class?

[Paul_Hossler]

I didn't have the startup code that sets the array, so I faked it

This seems to work to put the not Transposed to SHeet2 and the Transposed to Sheet3

Option Explicit

Dim aryIn As Variant

Sub drv()
    Dim r As Long, c As Long
    '---------------------------------- setup
    '5 rows x 7 cols
    aryIn = Worksheets("Sheet1").Range("B2").CurrentRegion.Value
    '----------------------------------- part 1 - no transpose
    'play with the data
    For r = LBound(aryIn, 1) To UBound(aryIn, 1)
        For c = LBound(aryIn, 2) To UBound(aryIn, 2)
            aryIn(r, c) = 2 * aryIn(r, c)
        Next c
    Next r
    'no Transpose, still 5 rows x 7 cols
    Worksheets("Sheet2").Range("C5").CurrentRegion.ClearContents
    Call WriteArrayToSheet(aryIn, Worksheets("Sheet2").Range("C5"))
    
    
    '----------------------------------- part 2 - with transpose
    'play with the data again
    For r = LBound(aryIn, 1) To UBound(aryIn, 1)
        For c = LBound(aryIn, 2) To UBound(aryIn, 2)
            aryIn(r, c) = 1.5 * aryIn(r, c)
        Next c
    Next r
    
    
    'with Transpose, now 7 rows x 5 cols
    Worksheets("Sheet3").Range("C5").CurrentRegion.ClearContents
    Call WriteArrayToSheet(aryIn, Worksheets("Sheet3").Range("C5"), True)
    
End Sub



Sub WriteArrayToSheet(vArray As Variant, StartAt As Range, _
    Optional bTranspose As Boolean = False)
    
    'not all arrays start at 1 and go to N
    Dim cntRows As Long, cntCols As Long
    cntRows = UBound(vArray, 1) - LBound(vArray, 1) + 1
    cntCols = UBound(vArray, 2) - LBound(vArray, 2) + 1
    
    If bTranspose Then
        StartAt.Resize(cntCols, cntRows).Value = Application.Transpose(vArray)
    Else
        StartAt.Resize(cntRows, cntCols).Value = vArray
    End If
End Sub

[JKwan]

hmm, sorry... objRecordSet is type ADODB.Recordset. This is a recordset that I retrieve back from Oracle. However, if I do a CopyRecordset command, I only get one row of data. That is why i issue
"objRec = objRecordSet.GetRows". So, now I use post #1, I can output all the records within objRecordSet.... I inspected the objRec, it is a 2D array (at least that is what i think it is). What you said may be true not an array.... Maybe I will just use the double loop to put the info onto the worksheet, I just thought that this is an easy task but turns out to be a hassle and may not worth the effort. Appreciate your help.

[JKwan]

Paul:
Thanks for your effort. Yes, it works, however, when I subbed your routine into my code, I get the error 13 again. Now, this makes me think that .GetRows may be doing something "different" to it..... I will just use my double loop to send data into my worksheet. Thank you Mike and Paul.

[snb]

Why don't you use:

Sub M_snb()
    c00 = "G:\Access\fiets.mdb"     '       file
    c01 = "Q_test"                       '      table
    
    With CreateObject("ADODB.recordset")
        .Open "SELECT * FROM " & c01, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & c00
        Sheet1.Cells(1).CopyFromRecordset .DataSource
    End With
End Sub

I only use getrows to fill a combobox/Listbox:

combobox1.Column=.getrows

To write the data from the database into the worksheet, using .getrows you might use this code (including a 'virtual Listbox').
But the 'copytorecordset' is evidently more elegant.

Sub M_snb_combobox_uit_database()
    c00 = "G:\Access\fiets.mdb"     '       file
    c01 = "Q_test"                       '      table
    Set lb = CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")  'virtual ListBox
    
    With CreateObject("ADODB.recordset")
        .Open "SELECT * FROM " & c01, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & c00
        lb.Column = .getrows
    End With
    
    Sheet1.Cells(1).Resize(UBound(lb.List) + 1, UBound(lb.List, 2)) = lb.List
End Sub

[mancubus]

@snb

table: 285.000 rows / 22 columns
W8.1, MSO 2013, network machine

Sheet1.Cells(1).CopyFromRecordset .DataSource

code execution time: 6 secs
same result in 4 tests

lb.Column = .getrows

code execution time: 14 secs
same result in 2 tests, rte in 6 tests
Run-time error -2147024882 (8007000e)
Not enough storage is available to complete this operation

[snb]

see:

http://www.vbaexpress.com/forum/show...l=1#post381688

[mancubus]

yes. and i posted my test results in order to provide a visual evidence to confirm your comment.

[JKwan]

@snb
- code #1 same result that I got - only one row was transfer to sheet (I don't know why, both CopyRecordSet and DataSource resulted in one row)
- code #2 this did the trick with the virtual listbox, exactly what I wanted
- by the way, can a user id and password be filled in with the below code?

Sub M_snb()
    c00 = "G:\Access\fiets.mdb"     '       file
    c01 = "Q_test"                       '      table
    
    With CreateObject("ADODB.recordset")
        .Open "SELECT * FROM " & c01, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & c00
        Sheet1.Cells(1).CopyFromRecordset .DataSource
    End With 
End Sub

@all - Thank you for helping.

[JKwan]

OK, solved the problem with one row being copied to sheet. Instead of using a DSN, I now use an Oracle Provider, now when I use CopyRecordSet, I get the entire dataset. Now, there is no need to do the Resizing.