1

I'd like to redim the size of multidimensional array that has many empty elements,

For one dimensional array I came up with this short code to find the index of first empty element.

arr = Array(4, 6, 7, "fjf", Empty, Empty, Empty)

i = 1
While arr(i) <> Empty
    i = i + 1
Wend

But is there a more direct way for a 2 dimensional array like below, to identify index of "row" with all empty elements? in this case should be 4.

Dim myArray(1 To 5, 1 To 7) As Variant
    myArray(1, 1) = 1
    myArray(1, 2) = 2
    myArray(1, 3) = 3
    myArray(1, 4) = 4
    myArray(1, 5) = 5
    myArray(2, 1) = 6
    myArray(2, 2) = 7
    myArray(2, 3) = 8
    myArray(2, 4) = 9
    myArray(2, 5) = 10
    myArray(3, 1) = 6
    myArray(3, 2) = 7
    myArray(3, 3) = 8
    myArray(3, 4) = 9
    myArray(3, 5) = 10
Rasec Malkic
  • 373
  • 1
  • 8

1 Answers1

3

Get Elements Before First Empty Row

The Function

Function GetBeforeEmptyRow(ByVal Data As Variant) As Variant

    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 UB2 As Long: UB2 = UBound(Data, 2)
    
    Dim r As Long, c As Long
    
    For r = LB1 To UB1
        For c = LB2 To UB2
            If Not IsEmpty(Data(r, c)) Then ' the row is not empty
                Exit For
            End If
        Next c
        If c > UB2 Then ' the row is empty
            Exit For
        End If
    Next r
    
    UB1 = r - 1
    
    Dim dData ' initially 'Empty' 
    
    If UB1 >= LB1 Then
        ReDim dData(LB1 To UB1, LB2 To UB2)
        For r = LB1 To UB1
            For c = LB2 To UB2
                dData(r, c) = Data(r, c)
            Next c
        Next r
    'Else ' the 1st row is empty; do nothing i.e. let the result be 'Empty' 
    End If

    GetBeforeEmptyRow = dData

End Function

The Test

Sub Test()

    Dim myArray(1 To 5, 1 To 7) As Variant
    myArray(1, 1) = 1
    myArray(1, 2) = 2
    myArray(1, 3) = 3
    myArray(1, 4) = 4
    myArray(1, 5) = 5
    myArray(2, 1) = 6
    myArray(2, 2) = 7
    myArray(2, 3) = 8
    myArray(2, 4) = 9
    myArray(2, 5) = 10
    myArray(3, 1) = 6
    myArray(3, 2) = 7
    myArray(3, 3) = 8
    myArray(3, 4) = 9
    myArray(3, 5) = 10
    
    Dim Data(): Data = GetBeforeEmptyRow(myArray)
    
    Debug.Print "Initial Limits [" & LBound(myArray, 1) & "," _
        & UBound(myArray, 1) & "][" & LBound(myArray, 2) & "," _
        & UBound(myArray, 2) & "]"
    
    If IsEmpty(Data) Then
        Debug.Print "The first row was empty."
    Else
        Debug.Print "Result Limits  [" & LBound(Data, 1) & "," _
            & UBound(Data, 1) & "][" & LBound(Data, 2) & "," _
            & UBound(Data, 2) & "]"
    End If

End Sub

The Result

Initial Limits [1,5][1,7]
Result Limits  [1,3][1,7]

The 1D Method (Redim Preserve)

Sub RemoveAfterEmpty(ByRef Arr As Variant)
    
    Dim LB As Long: LB = LBound(Arr)
    Dim UB As Long: UB = UBound(Arr)
    
    Dim n As Long
    
    For n = LB To UB
        If IsEmpty(Arr(n)) Then
            Exit For
        End If
    Next n
    
    n = n - 1
    
    If n >= LB Then ' the 1st element is not empty
        If n < UB Then
            ReDim Preserve Arr(LB To n)
        'Else ' no empty elements; do nothing
        End If
    Else ' the 1st element is empty
        Arr = Array()
    End If

End Sub

The 1D Test

Sub Test1D()
    
    Dim Arr(): Arr = Array(4, 6, 7, "fjf", Empty, Empty, Empty)
    
    Debug.Print "Initial [" & LBound(Arr) & "," & UBound(Arr) & "]"
    Debug.Print Join(Arr, ", ")
    
    RemoveAfterEmpty Arr
    
    If UBound(Arr) < LBound(Arr) Then
        Debug.Print "The first element was empty."
    Else
        Debug.Print "Result  [" & LBound(Arr) & "," & UBound(Arr) & "]"
        Debug.Print Join(Arr, ", ")
    End If

End Sub

The 1D Result

Initial [0,6]
4, 6, 7, fjf, , , 
Result  [0,3]
4, 6, 7, fjf
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • Thanks so much for your help. I've tried, but the output should be row 4 of this array. I mean, elements (4,1), (4,2),..., (4,N) have all values = empty. So, I'd like to redim myarray from `(1 to 5, 1 to 7)` to `(1 to 5, 1 to 3)`. I hope make sense – Rasec Malkic May 30 '23 at 07:41
  • You are mixing up rows and columns: the 1st (left) dimension is rows, while the 2nd (right) dimension is columns. In your particular case, there are `5` rows and you have populated 3 of them (not entirely, only the 1st `5` columns) so the function returns an array of size `[1,3][1,7]`, discarding the last two empty rows i.e. all rows after the first empty row (`4`) inclusive. You could utilize my [PrintData](https://stackoverflow.com/a/75007333) procedure, used to print a 2D array to the Immediate window, to make things clearer. – VBasic2008 May 30 '23 at 08:04
  • Thank you. It was a typo. You're right. I've made some tests and works wonderful!!! – Rasec Malkic May 30 '23 at 19:45