Home > OS >  VBA Get Max of First Dimension of Array
VBA Get Max of First Dimension of Array

Time:01-03

I need to get the max of only the first dimension of the array.

WorksheetFunction.Max(shifts_array) returns the maximum of all dimensions but I only need it of dimension 1

The array is (1 to 10, 1 to 2)

CodePudding user response:

Maximum of a 2D Array's Column

Option Explicit

Sub SliceColumn()
    
    Const ColumnIndex As Long = 1 ' Modify this.
    
    Dim Data As Variant: Data = GetSampleData
    
    ' Using 'Application.Index'...
    Dim Data1 As Variant: Data1 = Application.Index(Data, 0, ColumnIndex)
    'Data1(1, 1) = CVErr(2007)
    
    ' ... or using 'GetColumn':
    'Dim Data1 As Variant: Data1 = GetColumn(Data, ColumnIndex)
    
    Dim MaxValue As Variant: MaxValue = Application.Max(Data1)
    If IsNumeric(MaxValue) Then
        Debug.Print "The maximum value is " & MaxValue
    End If

    Dim r As Long
    
    Debug.Print "Source"
    For r = 1 To UBound(Data, 1)
        Debug.Print Data(r, 1), Data(r, 2)
    Next r
    
    Debug.Print "Sliced Column " & ColumnIndex
    For r = 1 To UBound(Data1, 1)
        Debug.Print Data1(r, 1)
    Next r

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values from a column of a 2D array
'               in a 2D one-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumn( _
    ByVal Data As Variant, _
    ByVal ColumnIndex As Long) _
As Variant
    Const ProcName As String = "GetColumn"
    On Error GoTo ClearError

    Dim LB1 As Long: LB1 = LBound(Data, 1)
    Dim UB1 As Long: UB1 = UBound(Data, 1)
    Dim LB2 As Long: LB2 = LBound(Data, 2)
    
    Dim cData As Variant: ReDim cData(LB1 To UB1, LB2 To LB2)
    
    Dim r As Long
    
    For r = LB1 To UB1
        cData(r, 1) = Data(r, ColumnIndex)
    Next r
    
    GetColumn = cData

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a 2D one-based array containing sequential numbers
'               added by columns (one column at the time).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSampleData()
    Dim Data As Variant: ReDim Data(1 To 10, 1 To 2) ' e.g. increase 2
    Dim r As Long, c As Long, n As Long
    For c = 1 To UBound(Data, 2)
        For r = 1 To UBound(Data, 1)
            n = n   1
            Data(r, c) = n
        Next r
    Next c
    GetSampleData = Data
End Function

CodePudding user response:

How about resizing the array to 1 column

ReDim Preserve MyArray(1 To UBound(MyArray), 1 To 1)
MaxFirstColumn = WorksheetFunction.Max(MyArray)
  • Related