2

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
4
  • 1
    Is the input array a column or a row?? Commented Oct 20, 2017 at 17:25
  • Exactly what are you passing to this function? You cannot use ArrayWithoutBlanks without first sizing it (which you don't do) Commented Oct 20, 2017 at 17:34
  • If you are using another array to store can't you loop the input array, test each value, if not VBNullstring/0, redim the other array adding the value. use a counter which you increment to both redim the array you are storing in and to indicate the position to store. Commented Oct 20, 2017 at 17:35
  • I am inputting a column. Could I size it using ArrayWithoutBlanks(UBound(ArrayToCondense))? I need it to be dynamic. Commented Oct 20, 2017 at 18:02

5 Answers 5

2

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
Sign up to request clarification or add additional context in comments.

Comments

1

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

Comments

1

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()

Comments

1

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

Comments

1

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

Filter(arrayElement, "", False)

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.