Out of memory Run-time 7 Transferring data

[ItalianPlatinum]

I am running into a runtime error trying to transfer data using VBA I used before so I know it works. But when facing a larger data set it is kicking out the below. is there any root cause / solution I can entertain?

If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then

'transfer data over to Compare tab
  vCols = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17) '<- Columns of interest in specified order
  With WsSec
    With .Range("A11:R" & .Range("H" & rows.count).End(xlUp).row)
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(17))
            For ii = 1 To UBound(vRows)
                If vRows(ii, 1) > "1" Then
                    kk = kk + 1
                    vRows(kk, 1) = ii
        End If
      Next ii
        nrALL = WsALL.Range("A" & rows.count).End(xlUp).row + 1
        WsALL.Range("A" & nrALL).Resize(kk, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
    End With
  End With
    End If

kk = 0
ii = 0
rng = 0
Debug.Print "CountIf Formula/delete/transfer... : " & Format(Timer - t, "0.00") & " seconds"
  
'apply filter to start and activate sheet
With WsSec
    .Application.Calculation = xlManual
    .Range("A10").CurrentRegion.Delete
End With
  
    i = i + 1
Loop

With WsALL
lr2 = .Cells(rows.count, "A").End(xlUp).row 'find the maximum row
    .Cells.EntireColumn.AutoFit
    .Range("1:1").AutoFilter
End With

Else

at this spot it fails

WsALL.Range("A" & nrALL).Resize(kk, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)

 

[Micron]

Take it in chunks? AFAIK, array size limit is governed by your available pc memory.
Maybe have a For Next loop that takes n rows at a time, writes/copies data then begins again at n+1.
So if last row = 100,000 loop from 2 (?) to 10,000 and write/copy.
Then increment start position by ending value (10,000) +1; ending value by 10,000 + 10,000 (or last row value if that is smaller).
Or shell out for more memory.

 

[ItalianPlatinum]

So depending on my PC memory I really don't know what the array size limit could be. Reason I ask is I would need it to run as is but then have this new procedure if there is a possibility i reach that limit? I may need help in modifying to fit that type of procedure, this way I can test out and see how it handles / avoids the error. I will also try to close everything on my PC tomorrow and give it a run as is to see if it can handle it with nothing else open.

 

[Micron]

You may have to rely on someone who is better at Excel vba than me. I'm more of an Access VBA guy.
I look at that and figure you're copying a range to another sheet but using what looks like a 2 dimensional array to do it. I've never seen that approach for that purpose, so I figure I must be wrong about that.

The only other thing I can suggest (and this is only because I can't see the declarations) is that if they're not specifically data-typed (e.g. kk) then you'll end up with a variant variable that will use more memory.

 

[ItalianPlatinum]

Here are my declarations if it helps.

    Dim vCols As Variant, vRows As Variant
    Dim ii As Long, kk As Long, nrALL As Long

 

[Alex Blakenburg]

Is this a realistic example ?
vCols = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17)
They are in order and there are no numbers missing.

Any reason you are not using an output array rather than relying on Index with arrays for the rows and columns ?
Also please post some sample data preferably using XL2BB.

 

[ItalianPlatinum]

Probably not the best approach, agreed there Alex. I was leveraging older code where the columns would be out of order to its destination. This procedure is pretty uniform, and didn't know a more efficient way so just copied, pasted and modified

tax lot cons2.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3
4
5
6
7
8	D	9	A	C	L	T	Q	C	BC	OC	CUR	UC	BUY	UQ	CS
9
10	Date	Indicator	Account	SKU	Open Date	Lot #	QTY	Local Cost	Base Cost	Orig Cost	Currency	Unit Cost	Buyer	Unique Code	Rounded Unit Cost	Formula	Occurrence
11	22-May	A	ABC	G12345678	1/1/2020	1	10	100	100	100	USD	10	John	Z	10	_G1234567810	2
12	22-May	A	ABC	G12345678	1/1/2021	2	20	200	200	200	USD	10	Tom	x	10	_G1234567820	2
13	22-May	A	ABC	G12345678	9/1/1999	3	30	999	999	999	USD	33.3	Sally	c	33.3	_G1234567830	1
14	22-May	A	ABC	G12345678	1/6/1989	4	40	665	665	665	USD	16.625	Donna	v	16.63	_G1234567840	1
15	22-May	A	ABC	G12345678	10/15/2022	5	50	140	140	140	USD	2.8	Tim	f	2.8	_G1234567850	1
16	22-May	A	ABC	G12345678	6/6/1996	6	60	356	356	356	USD	5.933333333	Abigail	s	5.93	_G1234567860	1
17	22-May	A	ABC	G12345678	7/8/1990	7	70	9850	9850	9850	USD	140.7142857	Mike	s	140.71	_G1234567870	1
18	22-May	A	ABC	G12345678	4/9/2009	8	80	1584	1584	1584	USD	19.8	Chirstine	w	19.8	_G1234567880	1
19	22-May	A	ABC	G12345678	11/11/2005	9	90	4587	4587	4587	USD	50.96666667	Sabrina	t	50.97	_G1234567890	1
20	22-May	A	ABC	G12345678	10/1/2008	10	100	4587	4587	4587	USD	45.87	John	t	45.87	_G12345678100	1
Source

Cell Formulas
Range	Formula
O11:O20	O11	=ROUND(L11,2)
P11:P20	P11	="_"&D11&G11

 

[Alex Blakenburg]

See if this works and overcomes your issue:

If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then
    '----- Changed section -----
    Dim srcRng As Range, srcArr As Variant, destArr As Variant
    Dim j As Long
    
    With WsSec
        Set srcRng = .Range("A11:R" & .Range("H" & Rows.Count).End(xlUp).Row)
    End With
    srcArr = srcRng.Value
    vCols = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17) '<- Columns of interest in specified order
    ReDim destArr(1 To UBound(srcArr), 1 To UBound(vCols) + 1)
    
    For ii = 1 To UBound(srcArr)
        If srcArr(ii, 17) > 1 Then
            kk = kk + 1
            For j = 0 To UBound(vCols)
                destArr(kk, j + 1) = srcArr(ii, vCols(j))
            Next j
        End If
    Next ii
    
    nrAll = WsALL.Range("A" & Rows.Count).End(xlUp).Row + 1
    WsALL.Range("A" & nrAll).Resize(kk, UBound(vCols) + 1).Value = destArr  
    '----- End of Changed section -----
End If

 

[ItalianPlatinum]

still got an error but this time only the out of memory (runtime 7) so not the warning about 32 or 64 bit. Thought that was interesting....

but then ran it a second time and it kicked the error here

 

[Alex Blakenburg]

I have logged off for the night.
What is the value of nrAll and of kk when it errors out ?
And was is the last row number in the source data ?