PDA

View Full Version : [SOLVED] Array resizing help



JKwan
07-04-2018, 08:13 AM
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
07-04-2018, 09:18 AM
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
07-04-2018, 09:31 AM
What error do you get when bTranspose is True?

JKwan
07-04-2018, 10:32 AM
Thanks for the response. I used what you had on post #2, I got the same error Type Mismatch (Error 13)

mikerickson
07-04-2018, 01:08 PM
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
07-04-2018, 01:57 PM
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
07-04-2018, 01:57 PM
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
07-04-2018, 02:11 PM
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
07-04-2018, 02:37 PM
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
07-04-2018, 11:45 PM
@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
07-05-2018, 12:57 AM
see:

http://www.vbaexpress.com/forum/showthread.php?63111-Array-resizing-help&p=381688&viewfull=1#post381688

mancubus
07-05-2018, 04:07 AM
yes. and i posted my test results in order to provide a visual evidence to confirm your comment.
:thumb

JKwan
07-05-2018, 06:17 AM
@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
07-05-2018, 01:16 PM
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:whistle::whistle:.