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)

 

[ItalianPlatinum]

Not a worry Alex. Have a good night we will touch base later. See below for your request.

It seems to keep failing here

ReDim destArr(1 To UBound(srcArr), 1 To UBound(vCols) + 1)

So I don't get to the nrall or kk yet. srcRNG is saying out of memory. The last row on WsSec is 798,379

 

[Alex Blakenburg]

Given the memory issues you are having, take a copy of your existing workbook and try the below being an entirely different approach using the Advanced Filter.

If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then
    '----- Changed section -----
    Dim srcRng As Range, destRng As Range
    Dim srcLastCol As Long, srcNextCol, critRng As Range
    
    With WsSec
        Set srcRng = .Range("A10:R" & .Range("H" & Rows.Count).End(xlUp).Row)
        srcLastCol = .Cells(10, Columns.Count).End(xlToLeft).Column
        srcNextCol = srcLastCol + 2
        Set critRng = .Cells(10, srcNextCol).Resize(2)
        critRng.Cells(1).Value = .Cells(10, 17).Value
        critRng.Cells(2).Value = ">1"
    End With

    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
    nrAll = WsALL.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    Set destRng = WsALL.Range("A" & nrAll).Resize(1, UBound(vCols) + 1)
    destRng.Value = Application.Index(srcRng.Resize(1), 0, vCols)
    
    srcRng.AdvancedFilter xlFilterCopy, critRng, destRng
    critRng.Clear
    destRng.EntireRow.Delete
    
    '----- End of Changed section -----
End If

 

[ItalianPlatinum]

Working so far! I am going to test it further on my other datasets.

Would you be so kind on creating some comments / explanation this way I can understand it. Hopefully so it reduces my posts so I can self-service more

 

[ItalianPlatinum]

Also, if you want a thought provoking / new item feel free to look at another post of mine actually the same procedure you have helped on a few times along the way with this post and other posts

Range used for loops based off criteria

I need some help creating a line of code that will help me optimize my current VBA. I am running into performance issues because of running my loop off of each individual range but I can improve it by combining ranges. I have to apply each due to the size of my data. I have since improved it but...

www.mrexcel.com

 

[Alex Blakenburg]

Would you be so kind on creating some comments / explanation this way I can understand it. Hopefully so it reduces my posts so I can self-service more

The line that does the work is this one:
srcRng.AdvancedFilter xlFilterCopy, critRng, destRng
The rest of 2 code just sets that up.
1) critRng needs the column heading of the data column to use as a filter and the line under that is the criteria to use for the filter.
Since this is temporary it puts on WsSec 2 columns to the right of the last heading on row 10 then clears it afterwards.
2) destRng needs to have the headings exactly as they appear in the data on row 10 in the order that you want them in the output.
I am using your previous Index with vCols line to generate that and then removing the row once the data has been copied across.

It would be worth your while to watch Paul Kelly's (Excel MacroMastery video):
Its 18 mins but you only need the first 11.5 mins and the conversion of the Filter in Place to Filter Copy is at the 9 min mark.

 

[ItalianPlatinum]

That video was real helpful, thank you

 

[Alex Blakenburg]

Glad you liked it.