Append to array without knowing ahead how many to add to

[30percent]

Hi,

how do I append an item to an array without knowing how many to add to ahead of time? I created a generic example to illustrate.

Public Sub Add2Arr()


Set sht = ThisWorkbook.Worksheets("Sheet1")
lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row


Dim maxArr() As Variant


For i = 1 To lastRow


    If sht.Range("A" & i).Value Mod 2 = 0 Then
        'append to maxArr() array then find the max of even numbers
    Else
       'append to maxArr() array then find the max of odd numbers
    End If
    
Next


End Sub

 

[tonyyy]

30percent,

The following demonstrates the use of ReDim Preserve to add an item to an array...

Public Sub Add2Arr_1023455r2()
Dim sht As Worksheet
Dim lastrow As Long, i As Long, n As Long
Dim maxArr() As Variant

Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
n = 1
For i = 1 To lastrow
    If sht.Range("A" & i).Value Mod 2 = 0 Then
        ReDim Preserve maxArr(1 To 1, 1 To n)
        maxArr(1, n) = sht.Range("A" & i).Value
        n = n + 1
    End If
Next
MsgBox "max even " & WorksheetFunction.Max(Application.Index(maxArr, , n - 1))
End Sub

Given the generic example, you could also consider using "lastrow" to set the upper bound for the array...

Public Sub Add2Arr_1023455()
Dim sht As Worksheet
Dim lastrow As Long, i As Long
Dim maxArr() As Variant

Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
ReDim maxArr(1 To lastrow, 1 To 2)
For i = 1 To lastrow
    If sht.Range("A" & i).Value Mod 2 = 0 Then
        maxArr(i, 1) = sht.Range("A" & i).Value
    Else
       maxArr(i, 2) = sht.Range("A" & i).Value
    End If
Next
MsgBox "max even " & WorksheetFunction.Max(Application.Index(maxArr, , 1))
MsgBox "max odd " & WorksheetFunction.Max(Application.Index(maxArr, , 2))
End Sub

Cheers,

tonyyy

 

[30percent]

Hi Tonyyy,

I did the following to look at the structure of the array of odd numbers:

For i = LBound(Application.Index(maxArr, , 2)) To UBound(Application.Index(maxArr, , 2))
    Debug.Print "row " & i & " value is " & maxArr(i, 2)
Next

it resulted in:
row 1 value is 1
row 2 value is
row 3 value is 3
row 4 value is
row 5 value is 5
row 6 value is
row 7 value is 7
row 8 value is
row 9 value is 9
row 10 value is

So there are 10 rows for 5 items.
How do we code it so that, it would be 5 rows for 5 items. Same for the even column.

such as
row 1 value is 1
row 2 value is 3
row 3 value is 5
row 4 value is 7
row 5 value is 9

Thank you!

 

[tonyyy]

Use the construct in the first macro...

Public Sub Add2Arr_1023455r2()
Dim sht As Worksheet
Dim lastrow As Long, i As Long, n As Long
Dim maxArr() As Variant

Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
n = 1
For i = 1 To lastrow
    If sht.Range("A" & i).Value Mod 2 = 0 Then
        ReDim Preserve maxArr(1 To 1, 1 To n)
        maxArr(1, n) = sht.Range("A" & i).Value
        [COLOR=#ff0000]Debug.Print maxArr(1, n)[/COLOR]
        n = n + 1
    End If
Next
MsgBox "max even " & WorksheetFunction.Max(Application.Index(maxArr, , n - 1))
End Sub

Using ReDim Preserve in a loop and incrementing the index (n = n + 1) will resize the array to fit exactly the number of even (or odd) numbers.

The use of ReDim Preserve in a loop - while accomplishing what you want - isn't very efficient, thus the second macro which sizes the array only once. Having blank items in the array doesn't matter if all you're trying to do is find the max value... but maybe your example wasn't really representative of what you're trying to do.

 

[30percent]

Hi,

This is what I coded. However, the max of the array didn't come out as expected.

Public Sub bucketMinMax()
Set sht = ThisWorkbook.Worksheets("Sheet1")


finalRow = sht.Cells(sht.Rows.Count, "a").End(xlUp).Row


Dim maxArr50() As Variant
Dim n As Long


n = 1


For i = 2 To finalRow
    Bucket = sht.Range("N" & i).Value
    Select Case Bucket
        Case 50
            ReDim Preserve maxArr50(1 To 1, 1 To n)
            maxArr50(1, n) = sht.Range("S" & i).Value
            n = n + 1
            
    End Select
Next




For i = LBound(maxArr50, 2) To UBound(maxArr50, 2)
    Debug.Print maxArr50(1, i)
Next


Max = WorksheetFunction.Max(Application.Index(maxArr50, 1))
Debug.Print "Max is " & Max


End Sub

The outcome of the debug.print is:

81
54
95
Max is 81

The max should be 95. I messed around with this line of code to see if I could find out why the max is 81 instead of 95 but I couldn't figure out.

Max = WorksheetFunction.Max(Application.Index(maxArr50, 1))

 

[Norie]

Application.Index(maxArr50, 1) will return the first value in maxArr50.

 

[wideboydixon]

Not sure what you want your function to do; it seems a very inefficient way to find that value. However, the last line you need is:

Max = WorksheetFunction.Max(maxArr50)

WBD