Problem with nested loops to filter and find max

[justhumm]

This VBA question deals with the same workbook and data set configuration that I mentioned in a previous thread...
http://www.mrexcel.com/forum/excel-...match-criteria-copy-rows-different-sheet.html

The basic idea of the code (big box at the bottom) is to filter down a large (50K row) data set into a smaller array, whose rows match three different criteria, and then select either the max of minimum value of one of the array columns based on another condition.

The code worked for me once, when my outer-most loop ("m") was static, but once I looped it, I'm getting a bug/error message near the very bottom of the code:

arrControl(p, r) = arr001(FindControl, r)

...I'm getting a "Run-time error '9': Subscript out of range"...looking at the variable values, it's indicating that "FindControl" is empty.

I traced that back a few lines to another small loop (q) that I have:

For q = LBound(arr001, 1) To UBound(arr001, 1)
    If arr001(q, ColMax) > arrmax Then
        arrmax = arr001(q, ColMax)
        FindMax = q
    End If
    If arr001(q, ColMax) < arrmin Then
        arrmin = arr001(q, ColMax)
        FindMin = q
    End If
Next q

...it shows "arrmax" is empty there, but "arrmin" (which unfortunately isn't being used in this particular case) has a definite value. I haven't been able to find anything glaringly wrong, but the only thing I really noted was that (in my dataset) all of the values that arrmax is looking at are negative (and I'm checking for ">"), but I thought it shouldn't matter for the data types that I've declared...

I hope I've explained my situation clearly enough; and any help would be much appreciated.

Thanks.

Option Explicit     'Requires that all variables be defined


Sub filterarray()


Application.ScreenUpdating = False


Dim wsA As Worksheet: Set wsA = ThisWorkbook.Sheets("T2SC") 'Make sure these actually match the Sheet Names
Dim wsB As Worksheet: Set wsB = ThisWorkbook.Sheets("T4-Service Control")
Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("criteria")
Dim arrLoadCase, arrFrame, arrStep, arrCriteria, arr001, arrControl As Variant
Dim arrmax, arrmin As Single
Dim StepType, StepControl As String
Dim FindMax, FindMin, FindControl, count001 As Integer
Dim FirstRowA, FirstRowB, LastRowA, LastRowB, lastrowall, FirstCol, LastColA, LastColB As Integer
Dim ColFrameCrit, ColLoadCrit, ColStepCrit, ColMax, LastRowCrit As Integer
Dim i, j, k, m, n, o, p, q, r As Integer
Dim z As String


'------------------------------------------------------------
'User-Defined Criteria / Lookup Values
'------------------------------------------------------------
ReDim arrLoadCase(1 To 6)
ReDim arrFrame(1 To 4)
ReDim arrStep(1 To 12)
LastRowCrit = Evaluate(6 * 4 * 12)
ReDim arrCriteria(1 To LastRowCrit, 1 To 3)


arrLoadCase(1) = "combo PHL case"
arrLoadCase(2) = "combo PHL Neg-Mom case"
arrLoadCase(3) = "combo PHL Pier case"
arrLoadCase(4) = "combo H-20 case"
arrLoadCase(5) = "combo HS-20 case"
arrLoadCase(6) = "combo ML-80 case"
    arrFrame(1) = "R"
    arrFrame(2) = "C"
    arrFrame(3) = "B"
    arrFrame(4) = "F"
        arrStep(1) = "Max P"
        arrStep(2) = "Min P"
        arrStep(3) = "Max V2"
        arrStep(4) = "Min V2"
        arrStep(5) = "Max V3"
        arrStep(6) = "Min V3"
        arrStep(7) = "Max T"
        arrStep(8) = "Min T"
        arrStep(9) = "Max M2"
        arrStep(10) = "Min M2"
        arrStep(11) = "Max M3"
        arrStep(12) = "Min M3"
'------------------------------------------------------------
'Loop to popoulate the criteria array
'------------------------------------------------------------
' make sure destination cells are empty
wsC.Activate
wsC.Range(Cells(3, "A"), Cells(LastRowCrit, 3)).Clear


For i = 1 To Evaluate(6 * 4 * 12)
    j = 2
    For n = LBound(arrLoadCase) To UBound(arrLoadCase)
    arrCriteria(i, j) = arrLoadCase(n)
        For m = LBound(arrFrame) To UBound(arrFrame)
                arrCriteria(i, j - 1) = arrFrame(m)
            For o = LBound(arrStep) To UBound(arrStep)
                arrCriteria(i, j - 1) = arrFrame(m)
                arrCriteria(i, j) = arrLoadCase(n)
                arrCriteria(i, j + 1) = arrStep(o)
                i = i + 1
            Next o
            o = 1
        Next m
        m = 1
    Next n
    n = 1
Next i


' write / send array to worksheet for visual verification
wsC.Activate
wsC.Range(Cells(3, "A"), Cells(LastRowCrit, 3)) = arrCriteria


'------------------------------------------------------------
'------------------------------------------------------------
'User-Defined Known Row & Column Indexes
'------------------------------------------------------------
'------------------------------------------------------------
FirstRowA = 15       ' index number of the first data row in worksheet A
FirstRowB = 11
lastrowall = 65536  ' index number of the last row in any worksheet
FirstCol = 1        ' index number of the first column in any worksheet
LastColA = 13
ColFrameCrit = 1
ColLoadCrit = 3
ColStepCrit = 5
'------------------------------------------------------------
'------------------------------------------------------------


'make sure destination cells are empty
wsB.Activate
wsB.Range(Cells(FirstRowB, "A"), Cells(lastrowall, "M")).Clear
wsA.Activate
LastRowA = wsA.Cells(lastrowall, 1).End(xlUp).Row ' this counts number of rows that contain data
LastRowB = wsB.Cells(lastrowall, 1).End(xlUp).Row ' this counts number of rows that contain data


'count001 = Application.WorksheetFunction.CountIfs( _
'wsA.Cells(i, ColFrameCrit), like(
'wsA.Columns(ColLoadCrit), arrCriteria(m, 2), _
'wsA.Columns(ColStepCrit), arrCriteria(m, 3))


ReDim arr001(1 To Evaluate(LastRowA), 1 To LastColA)
ReDim arrControl(1 To LastRowCrit, 1 To LastColA)


'------------------------------------------------------------
'This loop breaks worksheetA up, based on the Criteria
'------------------------------------------------------------
'START REALLY BIG LOOK FOR M = 1 TO WHATEVER


p = 0
For m = 1 To LastRowCrit
    j = 0
    For i = FirstRowA To LastRowA
        If Left(wsA.Cells(i, ColFrameCrit), 1) = arrCriteria(m, 1) _
        And wsA.Cells(i, ColLoadCrit) = arrCriteria(m, 2) _
        And wsA.Cells(i, ColStepCrit) = arrCriteria(m, 3) _
        Then
        j = j + 1
            For k = 1 To LastColA
                arr001(j, k) = wsA.Cells(i, k)
            Next k
        End If


    Next i
'------------------------------------------------------------
'------------------------------------------------------------
If arr001(1, ColStepCrit) = arrStep(1) Then
    ColMax = 6
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) = arrStep(2) Then
    ColMax = 6
    StepType = "Min"
ElseIf arr001(1, ColStepCrit) = arrStep(3) Then
    ColMax = 7
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) = arrStep(4) Then
    ColMax = 7
    StepType = "Min"
ElseIf arr001(1, ColStepCrit) = arrStep(5) Then
    ColMax = 8
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) = arrStep(6) Then
    ColMax = 8
    StepType = "Min"
ElseIf arr001(1, ColStepCrit) = arrStep(7) Then
    ColMax = 9
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) = arrStep(8) Then
    ColMax = 9
    StepType = "Min"
ElseIf arr001(1, ColStepCrit) = arrStep(9) Then
    ColMax = 10
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) = arrStep(10) Then
    ColMax = 10
    StepType = "Min"
ElseIf arr001(1, ColStepCrit) = arrStep(11) Then
    ColMax = 11
    StepType = "Max"
ElseIf arr001(1, ColStepCrit) Like arrStep(12) Then
    ColMax = 11
    StepType = "Min"
End If
'------------------------------------------------------------
'------------------------------------------------------------
For q = LBound(arr001, 1) To UBound(arr001, 1)
    If arr001(q, ColMax) > arrmax Then
        arrmax = arr001(q, ColMax)
        FindMax = q
    End If
    If arr001(q, ColMax) < arrmin Then
        arrmin = arr001(q, ColMax)
        FindMin = q
    End If
Next q


If StepType = "Max" Then
    StepControl = arrmax
    FindControl = FindMax
ElseIf StepType = "Min" Then
    StepControl = arrmin
    FindControl = FindMin
End If


    p = p + 1
    
    For r = 1 To LastColA
        arrControl(p, r) = arr001(FindControl, r)
    Next r
    
Next m 'Back to the beginning




'------------------------------------------------------------
' write / send array to worksheet
'------------------------------------------------------------


wsB.Activate
wsB.Range(Cells(FirstRowB, "A"), Cells(-1 + FirstRowB + UBound(arrControl, 1), LastColA)) = arrControl


Application.ScreenUpdating = True
End Sub

 

[justhumm]

Yeah that was it...the negatives are causing problems for the max lookup:

For q = LBound(arr001, 1) To UBound(arr001, 1)
    If arr001(q, ColMax) > arrmax Then
        arrmax = arr001(q, ColMax)
        FindMax = q
    End If
    If arr001(q, ColMax) < arrmin Then
        arrmin = arr001(q, ColMax)
        FindMin = q
    End If
Next q

...I changed a handful of the negative numbers that arrmax was having a problem with and just made them positive, then the macro ran though like a champ.

So if anyone has any ideas to deal with the arrmax statement with all of the possible arrmax values being negative (without too much effort), I would love to hear them.

"If arr001(q, ColMax) > arrmax"

Thanks.