VBA Excel For loop with Variant Arrays crashing Excel

Question

Afternoon all. I'm working on adding and undetermined number of values (customers) to a variant array using a For/Next loop and ReDim Preserve. My code below:

lRow = sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
cCount = 0
uCount = 0

var_Events = sht1.Range("A2:BC" & lRow).Value2

For i = LBound(var_Events) To UBound(var_Events)

    ReDim Preserve var_Customers(0 To cCount)

    If Not CustInArray(str(var_Events(i, 2)), var_Customers) Then

        var_Customers(cCount) = str(var_Events(i, 2))
        cCount = cCount + 1

    End If

    If i Mod 100 = 0 Then

        MsgBox "Line: " & i

    End If

Next i

Here is the CustInArray function:`

Function CustInArray(str As String, arr As Variant) As Boolean

    CustInArray = (UBound(Filter(arr, str)) > -1)

End Function`

I added the Mod/MsgBox after it crashed the first time to see where/when it was crashing with no errors. It gets to about line 6000 before excel crashes (I don't see the "Line: 6000" MsgBox).

I've checked the UBound of the var_Events, and it is 6290 which is in line with the number of lines on my WS. I also tried (UBound(var_Events) - 1), and still no luck.

I'm not 100% why it's crashing since there's no error, so that's all I can provide for now. Thanks in advance!

EDIT: I mentioned this in the comments, but thought it would be good to add here. I initially thought to use dictionaries, but this is just the first part of a longer process. Each customer is going to have an unknown number of items assigned to them, and an unknown number of classes to those items.

Redim Preserve an array thousands of times is very resource consuming and probably exhausted the memory. I urge you to start using a Dictionary Object. — A.S.H
– A.S.H, Commented Jun 27, 2017 at 22:11
The memory isn't exhausted, I checked after you mentioned it. Never uses more than about 500MB (of 26GB available). I initially thought to use dictionaries, but this is just the first part of a longer process. Each customer is going to have an unknown number of items assigned to them, and an unknown number of classes to those items. — Eli A
– Eli A, Commented Jun 27, 2017 at 22:13
When you say Crashes what exactly does it do? Does excel shut down and go away? Is there an error? Or does it freeze and go white? — Scott Craner
– Scott Craner, Commented Jun 27, 2017 at 22:23
You might be interested in reading this. "32-bit versions of Excel seem to have a memory limit of about 500MB for VBA (arrays, code etc).". Dont assume that VBA will effectively exploit all available memory on your system. It has inherent limitations. Besides I dont wee why a Dictionary wouldn't fulfill those requirements you mentioned. — A.S.H
– A.S.H, Commented Jun 27, 2017 at 22:24
Seriously, redim the array one by one is an extremely bad design choice. For the least, allocate the maximum possible size at once then truncate the array at the end. But still bad. Dictionary is a possible alternative, not the only one though. — A.S.H
– A.S.H, Commented Jun 27, 2017 at 22:42

barrowc · Accepted Answer · 2017-06-27 22:39:15Z

Start off with the array being large enough to hold a value from every row and then shrink it at the end with ReDim Preserve to the correct size:

lRow = sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
ReDim var_customers(0 to lRow - 1)
cCount = 0
uCount = 0

var_Events = sht1.Range("A2:BC" & lRow).Value2

For i = LBound(var_Events) To UBound(var_Events)
    If Not CustInArray(str(var_Events(i, 2)), var_Customers) Then
        var_Customers(cCount) = str(var_Events(i, 2))
        cCount = cCount + 1
    End If

    If i Mod 100 = 0 Then
        MsgBox "Line: " & i
    End If
Next i

ReDim Preserve var_customers(0 to cCount)

There are better ways to do this, however, a Dictionary object (as pointed out in comments), the built-in "Remove Duplicates" command, or use ADO - like this:

' Set up connection
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")

' Connection string for Excel 2007 onwards .xlsm files
With cn
   .Provider = "Microsoft.ACE.OLEDB.12.0"
   .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
        "Extended Properties=""Excel 12.0 Macro;IMEX=1"";"
    .Open
End With

' Connection string for Excel 97-2003 .xls files
' It should also work with Excel 2007 onwards worksheets
' as long as they have less than 65536 rows
'With cn
'    .Provider = "Microsoft.Jet.OLEDB.4.0"
'    .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
'        "Extended Properties=""Excel 8.0;IMEX=1"";"
'    .Open
'End With

' Create and run the query
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")

' Get all unique customers - assumes worksheet is named "Sheet1"
' and column name in cell B1 is "Customer"
rs.Open "SELECT DISTINCT [Customer] FROM [Sheet1$];", cn

' Output the field names and the results
Dim fld As Object
Dim i As Integer

' Change the worksheet to whichever one you want to output to
With Worksheets("Sheet3")
    .UsedRange.ClearContents

    For Each fld In rs.Fields
        i = i + 1
        .Cells(1, i).Value = fld.Name
    Next fld

    .Cells(2, 1).CopyFromRecordset rs

    ' You could now read the range values back into a variant array if you wanted to
End With

' Tidy up
rs.Close
cn.Close

Collectives™ on Stack Overflow

VBA Excel For loop with Variant Arrays crashing Excel

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related