# Dynamic array resizing and nesting conditions

This function filters a 2D VBA array base on the strKeeper value. Depending on the Boolean toggle it would either retain or skip "rows."

Two questions:

1. I went at length to size the arr_new in a separate loop to reDim it only once (did not want to put ReDim inside the loop). Is there a better way?
2. Is there a more efficient way to nest the following:

If (arr_col_k(i, 1) = strKeeper And re_Tain) Or (arr_col_k(i, 1) <> strKeeper And Not re_Tain) Then


Function RemoveRows2D(arr As Variant, k As Long, strKeeper As String, headers As Boolean, Optional re_Tain As Boolean = True) As Variant
'removes rows not equal (re_Tain=False) or equal (re_Tain=True) to strKeeper in col k

Dim i As Long, j As Long, ii As Long, up_new As Long
Dim arr_col_k, arr_new

arr_col_k = Application.Index(arr, 0, k) 'col with strings
up_new = 0 'calc Ubound(arr_new) based on matched
For i = LBound(arr_col_k) To UBound(arr_col_k)
If (arr_col_k(i, 1) = strKeeper And re_Tain) Or (arr_col_k(i, 1) <> strKeeper And Not re_Tain) Then
up_new = up_new + 1
End If
Next
If headers Then up_new = up_new + 1
ReDim arr_new(LBound(arr) To up_new, LBound(arr, 2) To UBound(arr, 2))

i = LBound(arr)
ii = i
For j = LBound(arr, 2) To UBound(arr, 2)
arr_new(i, j) = arr(i, j)
Next
i = 1 + 1
up_new = up_new + 1
End If

For i = i To UBound(arr) 'outter loop by rows to find match

If (arr_col_k(i, 1) = strKeeper And re_Tain) Or (arr_col_k(i, 1) <> strKeeper And Not re_Tain) Then
ii = ii + 1
For j = LBound(arr, 2) To UBound(arr, 2) 'inner loop by columns to fill in arr_new row
arr_new(ii, j) = arr(i, j)
Next
End If
Next
RemoveRows2D = Application.Transpose(arr_new)
End Function


Looping through the Array, counting the matches to avoid resizing the return Array is very efficient.

Application.Transpose is not needed because the return array is in the same shape as the original array.

RemoveRows2D = Application.Transpose(arr_new)

This is correct:

RemoveRows2D = arr_new

Using Application.Index to slice off the target column is a cool trick but is it really needed? Not only does it add extra overhead but it adds an extra variable. In my opinion, arr_col_k is just extra clutter because I don't think that arr_col_k(i, 1) = strKeeper is any more readable than arr(i, x) = strKeeper.

arr_col_k = Application.Index(arr, 0, k)

You can remove up_new = up_new + 1 from this loop:

If Headers Then                                   'handle header row
For j = LBound(arr, 2) To UBound(arr, 2)
arr_new(i, j) = arr(i, j)
Next
i = 1 + 1
up_new = up_new + 1
End If


Moving forward, the main thing that I think you should focus on is the names of your variables. Consider arr, k, strKeeper, up_new, arr_col_k, arr_new, what do the names of these variable tell you about the roles that they play?

Compare them to my alternative names.

• arr: Data, DataArray, arrData, arrSource, Source, SourceArray
• k: col, ColumnIndex
• strKeeper: Match
• I use Match because it is used in many VBA and Excel functions.
• up_new: Count
• arr_new: Results, results, arrResults

I also use 1 or 2 character variable names for all my counters. I prefer x, x1, y, y1 because i or l can be tough to differentiate.

RemoveRows2D is basically a 2D version of the built in VBA.Filter function. Whenever I write a version of a standardized method I start by copying the methods signature from the Object Browser and work from there. Using the same structure and variable names as the built-in methods will make it easier for others to understand and use yours.

Question: Is there a more efficient way to nest the following:

If (arr_col_k(i, 1) = strKeeper And re_Tain) Or (arr_col_k(i, 1) <> strKeeper And Not re_Tain) Then


Technically, using If and EsleIf blocks is more efficient because the VBA evaluates all the conditions in an If Then statement. In your case the difference in efficiency is negligible. Note: In my version of function I use a flag with If and EsleIf blocks because I think that it read better and is easier to debug.

If (arr_col_k(i, 1) = strKeeper And re_Tain) Then

ElseIf (arr_col_k(i, 1) <> strKeeper And Not re_Tain) Then

End If


Function Filter2D(SourceArray, Match As String, ColumnIndex As Long, Headers As Boolean, Optional Include As Boolean = True, Optional Compare As VbCompareMethod = vbBinaryCompare) As Variant()
Dim count As Long, x As Long, y As Long
Dim flag As Boolean
Dim Results() As Variant
'Adjust the ColumnIndex based on SourceArray Lbound
'This allows the user to refer to the 1st column of a Option Base 0 array as 1 instead of 0
ColumnIndex = ColumnIndex - LBound(SourceArray, 2) + 1
'First loop to count matches
For x = LBound(SourceArray) To UBound(SourceArray)
If x = LBound(SourceArray) And Headers Then
count = count + 1
ElseIf Include Then
If StrComp(SourceArray(x, ColumnIndex), Match, Compare) = 0 Then count = count + 1
Else
If StrComp(SourceArray(x, ColumnIndex), Match, Compare) <> 0 Then count = count + 1
End If
Next

If count = 0 Then Exit Function

'Adjust the count based on SourceArray Lbound
count = count - LBound(SourceArray) + 1
'Size the Results array to fit the data
ReDim Results(LBound(SourceArray) To count, LBound(SourceArray, 2) To UBound(SourceArray, 2))
'Reset count for reuse
count = LBound(SourceArray)
'Second loop to transfer the data
For x = LBound(SourceArray) To UBound(SourceArray)
If x = LBound(SourceArray) And Headers Then
flag = True
ElseIf Include Then
If StrComp(SourceArray(x, ColumnIndex), Match, Compare) = 0 Then flag = True
Else
If StrComp(SourceArray(x, ColumnIndex), Match, Compare) <> 0 Then flag = True
End If

If flag Then
For y = LBound(SourceArray, 2) To UBound(SourceArray, 2)
Results(count, y) = SourceArray(x, y)
Next
count = count + 1
End If
flag = False
Next

Filter2D = Results
End Function

• Thanks much, i will be sure to incorporate your suggestions. A very interesting if not unusual comment on variable names as almost every reference suggest avoiding common names such as Match not to interfere with reserved keywords. I guess it does not matter within function's local scope. Re: VBA.Filter method on 1D array, while it's fast and powerful, it does not provide an exact match (but a wildcard like) so need to be careful as i got burned before. – Vrun Jan 4 '18 at 15:29
• I did forget that VBA.Filter uses an Instr comparison. I used it in my answer to Is it possible to use auto-filter or find on a dictionary? which I thought was cool. – user109261 Jan 4 '18 at 15:48
• Match is not a built in VBA function it is an Excel WorksheetFunction – user109261 Jan 4 '18 at 15:50
• Your comment inspired me to do a quick hack of my code giving add an option for an exact match. Filter2D. It is definitely not pretty needs refactoring. Just something to think about when you rewrite your code. – user109261 Jan 4 '18 at 16:02

using Thomas's suggestions here is a very similar function but this employs VBA.Filter for membership test. It filters 2D array by an array containing column names:

Function FilterColumns2D(arrIn As Variant, strArrMatch() As String, Optional Include As Boolean = False) As Variant
'removes columns either not equal (Include=False) or equal (Include=True) to strArrMatch in top row
Dim i As Long, j As Long, cnt As Long, testMatch As Long
Dim Flag As Boolean, arrOut

'loop to count matches for sizing arrOut columns
For j = LBound(arrIn, 2) To UBound(arrIn, 2)
If UBound(Filter(strArrMatch, arrIn(1, j), , vbTextCompare)) <> -1 Then
cnt = cnt + 1
End If
Next
If cnt = 0 Then Exit Function
If Not Include Then cnt = UBound(arrIn, 2) - LBound(arrIn, 2) + 1 - cnt

'size the arrOut
ReDim arrOut(LBound(arrIn) To UBound(arrIn), LBound(arrIn, 2) To cnt)

'Reset cnt for reuse
cnt = LBound(arrIn, 2)

'Second loop to populate arrOut (all rows, some columns)
For j = LBound(arrIn, 2) To UBound(arrIn, 2) 'outer loop by columns
testMatch = UBound(Filter(strArrMatch, arrIn(1, j), , vbTextCompare))
If Include Then
If testMatch <> -1 Then Flag = True
Else
If testMatch = -1 Then Flag = True
End If

If Flag Then
For i = LBound(arrIn) To UBound(arrIn) 'inner loop by rows
arrOut(i, cnt) = arrIn(i, j)
Next
cnt = cnt + 1
End If
Flag = False
Next

FilterColumns2D = arrOut
End Function