Using VBA to filter out empty cells in an array

Question

I am trying to make a function that takes in a 1D array, filters out by empty cells, and then condenses the array and returns it.

Example: [1][2][3][""][4] returns [1][2][3][4]

I keep getting #Value! when I try to call this new array via index().

Function BlankRemover(ArrayToCondense As Variant) As Variant

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Long
Dim ArrayWithoutBlanksIndex As Long

ArrayWithoutBlanksIndex = 1

    For CellsInArray = LBound(ArrayToCondense) To UBound(ArrayToCondense)

        If ArrayToCondense(CellsInArray) <> "" Then

        ArrayWithoutBlanks(ArrayWithoutBlanksIndex) = ArrayToCondense(CellsInArray).Value

        ArrayWithoutBlanksIndex = ArrayWithoutBlanksIndex + 1

        End If

    Next CellsInArray

ReDim Preserve ArrayWithoutBlanks(LBound(ArrayToCondense) To ArrayWithoutBlanksIndex)

ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
BlankRemover = ArrayWithoutBlanks

End Function

Answer 1

For those who are coming later looking for a simple answer:

Filter(arrayElement, "", False)

Answer 2

There are a couple of issues with your code itself. Make the new array initially equal to the size of the original array; then do one "ReDim Preserve" at the end. Also, don't use a value like "1", arrays can have multiple starting indices. Here's what the code would ideally look like for doing this with arrays (though as I'll note below, I don't think that's actually what you want):

Function blankRemover(arr As Variant) As Variant

    If Not IsArray(arr) Then
        Exit Function
    End If

    ReDim newArr(LBound(arr) To UBound(arr))
    Dim i As Long
    Dim j As Long
    j = LBound(arr)

    For i = LBound(arr) To UBound(arr)
        If Not arr(i) = "" Then
            newArr(j) = arr(i)
            j = j + 1
        End If
    Next

    ReDim Preserve newArr(LBound(arr) To j - 1)
    blankRemover = newArr

End Function

But based on your comments, it sounds like you're not actually passing this function an array: you're passing it a range. So you'd actually want to use something like this:

Function blankRemoverRng(rng As Range) As Variant

    If Not ((rng.Rows.Count = 1) Xor (rng.Columns.Count = 1)) Then
        Exit Function
    End If

    Dim arr As Variant
    arr = narrow2dArray(rng.Value)

    ReDim newArr(LBound(arr) To UBound(arr))
    Dim i As Long
    Dim j As Long
    j = LBound(arr)

    For i = LBound(arr) To UBound(arr)
        If Not arr(i) = "" Then
            newArr(j) = arr(i)
            j = j + 1
        End If
    Next

    ReDim Preserve newArr(LBound(arr) To j - 1)
    blankRemoverRng = newArr

End Function
Function narrow2dArray(ByRef arr As Variant, Optional ByVal newBase As Long = 1) As Variant
'Takes a 2d array which has one dimension of size 1 and converts it to a 1d array with base newBase
'IE it takes an array with these dimensions:
    'Dim arr(1 To 10, 1 To 1)
'And turns it into an array with these dimensions:
    'Dim arr(1 To 10)

    On Error GoTo exitStatement
    Dim bigDim As Integer
    If Not IsArray(arr) Then
        Dim smallArr(1 To 1) As Variant
        smallArr(1) = arr
        narrow2dArray = smallArr
        Exit Function
    ElseIf LBound(arr, 1) = UBound(arr, 1) Then
        bigDim = 2
    ElseIf LBound(arr, 2) = UBound(arr, 2) Then
        bigDim = 1
    Else
        GoTo exitStatement
    End If

    ReDim tempArr(newBase To UBound(arr, bigDim) - LBound(arr, bigDim) + newBase) As Variant

    Dim i As Long
    Dim j As Long
    j = LBound(arr, bigDim)
    If bigDim = 2 Then
        For i = LBound(tempArr) To UBound(tempArr)
            If IsObject(arr(1, j)) Then
                Set tempArr(i) = arr(1, j)
            Else
                tempArr(i) = arr(1, j)
            End If
            j = j + 1
        Next
    Else
        For i = LBound(tempArr) To UBound(tempArr)
            If IsObject(arr(j, 1)) Then
                Set tempArr(i) = arr(j, 1)
            Else
                tempArr(i) = arr(j, 1)
            End If
            j = j + 1
        Next
    End If
    On Error GoTo 0

    narrow2dArray = tempArr
    Exit Function

exitStatement:
    MsgBox "Error: One of array's dimensions must have size = 1"
    On Error GoTo 0
    Stop

End Function

Answer 3

You declared the function

Function BlankRemover(ArrayToCondense As Variant) As Variant

so that ArrayToCondense is not an array, to make it an array you switch ArrayToCondense with ArrayToCondense() so the final code will be:

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Answer 4

Try below:

Notes:

1. You should define BlankRemover as an array: Variant()
2. .Value not needed at end of ArrayToCondense(CellsInArray)

The code:

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Long
Dim ArrayWithoutBlanksIndex As Long

ArrayWithoutBlanksIndex = 0

    For CellsInArray = LBound(ArrayToCondense) To UBound(ArrayToCondense)

        If ArrayToCondense(CellsInArray) <> "" Then

        ReDim Preserve ArrayWithoutBlanks(ArrayWithoutBlanksIndex)

        ArrayWithoutBlanks(ArrayWithoutBlanksIndex) = ArrayToCondense(CellsInArray)

        ArrayWithoutBlanksIndex = ArrayWithoutBlanksIndex + 1

        End If

    Next CellsInArray

    'ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
    BlankRemover = ArrayWithoutBlanks

End Function 'BlankRemover

Answer 5

Try this:

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Variant
ReDim ArrayWithoutBlanks(1 To 1) As Variant
For Each CellsInArray In ArrayToCondense
    If CellsInArray <> "" Then
        ArrayWithoutBlanks(UBound(ArrayWithoutBlanks)) = CellsInArray
        ReDim Preserve ArrayWithoutBlanks(1 To UBound(ArrayWithoutBlanks) + 1)
    End If
Next CellsInArray

ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
BlankRemover = Application.Transpose(ArrayWithoutBlanks)

End Function