Variant Array multiple errors and failure

Question

People of the internet, I need your help! I am trying to use variant arrays to summarise a large dataset of performance data into individual scores.

I have a table with about 13000 rows and about 1500 employees to loop through.

I am not new to VBA and have used this method before so I do not know what is going wrong.

I either get a "Subscript out of Range" when the for loop exceeds the UBound of the array or a bunch of "Next without For", "End Select without Select" regardless of whether the "End" or "Next" is there or not.

Please help?

Sub createScore()

Dim loData As ListObject
Dim arrData() As Variant, arrSummary As Variant
Dim lRowCount As Long, a As Long, b As Long
  Set loData = Sheets("DataMeasure").ListObjects("tbl_g2Measure")
    arrData = loData.DataBodyRange
    lRowCount = Range("A6").Value

    Range("A8").Select
    For a = 1 To lRowCount
      Selection.Offset(1, 0).Select

        For b = LBound(arrData) To UBound(arrData)
          If arrData(b, 2) = Selection Then
            Select Case arrData(b, 8)
               Case "HIT"
                Selection.Offset(0, 3) = Selection.Offset(0, 3) + 1
            End Select
          End If
        Next b

    Next a
    Range("A8").Select

End Sub

Subscript out of Range is obvious; you're going outside the bounds of the array. The rest sounds like issues with your conditional. I'd step through it to see what's happening. — fbueckert, Jan 30 '19 at 15:03
Don't use Select https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — SJR, Jan 30 '19 at 15:06
So I tried the "For b" 1 to 13237 and it still managed to get to 13238 when the break hits. — Chris Stuart, Jan 30 '19 at 15:06
I'm not sure I understand the point of your code. Are you just trying to populate a cell dependent on a criteria? If so you could just use an `IF` statement in Excel. Also, your first loop doesn't seem to be doing anything, and lastly why use an array? You aren't really doing anything with it anyway. — Tom, Jan 30 '19 at 15:09
SJR - the .Select isnt the issue, that is the only bit working correctly at the moment. Ultimately I want to load the list of users into another array rather than .Select but I'm still trying the code. — Chris Stuart, Jan 30 '19 at 15:09
Tom - Hi! I want to use an array because the way its currently done (45,000ish COUNTIFS) takes the poor lady's spreadsheet and computer out of action for about 10 mins. — Chris Stuart, Jan 30 '19 at 15:11
Have you addressed fbueckert's comment? Your question isn't very clear because we can't know anything about your set up, we don't eve know which line errors. You need to do some debugging yourself, step through, use the locals window. — SJR, Jan 30 '19 at 15:13
@ChrisStuart I can understand why you'd use an array, but in your code you're still doing everything using `Select` statements (very poor performance) and also referring to the sheet (again slow read write compared to the array). So you aren't really leveraging any performance gains by using it — Tom, Jan 30 '19 at 15:13

score 0 · Answer 1 · answered Jan 30 '19 at 15:18

A quick rewrite without using Select. This still isn't having any gains from the array though.

Sub createScore()
    Dim loData As ListObject
    Dim arrData() As Variant, arrSummary As Variant
    Dim lRowCount As Long, a As Long, b As Long

    Set loData = Sheets("DataMeasure").ListObjects("tbl_g2Measure")
    arrData = loData.DataBodyRange
    lRowCount = Range("A6").Value

    ' Update with correct sheet reference
    With ActiveSheet.Range("A8")
        For a = 1 To lRowCount
            For b = LBound(arrData, 1) To UBound(arrData, 1)
                If arrData(b, 2) = .Offset(a, 0).Value2 And arrData(b, 8) = "HIT" Then
                    .Offset(a, 3) = .Offset(a, 4)
                End If
            Next b
        Next a
    End With
End Sub

score 0 · Answer 2 · answered Jan 30 '19 at 15:33

I have needed to do something similar where the user list had duplicates so I created an array of unique usernames:

Dim arr() As String
lrn = 13237 'ActiveSheet.Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
ac = 0
ReDim arr(0 To ac) As String
For Each c In Range("L2:L" & lrn)
    If Not IsEmpty(c.Value) Then
        If Not (UBound(Filter(arr, c.Value)) > -1) Then
            If ac > 0 Then ReDim Preserve arr(0 To ac)
            arr(ac) = c.Value
            ac = ac + 1
        End If
    End If
    DoEvents
Next c

Variant Array multiple errors and failure

2 Answers2