Return Non-Blanks from Multiple Columns

I have been trying to extract non-blank cells from an entire range consisting of multiple columns, into a list in one column, without any luck though. I have an array which works for a single column, though when I expand its range, it fails.

Here's a sample range

Any help would be greatly appreciated!

Cheers,

Francis

2 answers

  • answered 2018-01-11 20:53 user1274820

    Here is an example:

    Sub Test()
    Dim c As Variant, NB As New Collection
    For Each c In [A1:D10] 'Whatever range to check
        If c <> "" Then NB.Add c
    Next c
    For Each c In NB
        Debug.Print c 'Do whatever you want with this list here
    Next c
    End Sub
    

    Input using [A1:D10]

    Input

    Output in debug window:

    Output

    Alternate using variant arrays - faster for larger ranges, less elegant code wise imo:

    Sub Test()
    Dim r(), s As New Collection, x, y, z
    r = Range("A1:D10")
    For x = 1 To UBound(r, 1)
        For y = 1 To UBound(r, 2)
            If r(x, y) <> "" Then s.Add r(x, y)
        Next y
    Next x
    For Each z In s
        Debug.Print z 'Do whatever you want with this list here
    Next z
    End Sub
    

    Edit:

    You can put it directly in an array:

    Redim Preserve may have some performance issues with large ranges and that's why it's better to use a collection IMO - but it will likely make no difference in your code.

    http://www.vbforums.com/showthread.php?450819-Is-it-bad-or-slow-to-use-Redim-Preserve-many-many-many-times

    Sub Test()
    Dim c, arr(), count
    count = 0
    For Each c In [A1:D10] 'Whatever range to check
        If c <> "" Then
            ReDim Preserve arr(count + 1)
            arr(count) = c
            count = count + 1
        End If
    Next c
    For x = 0 To UBound(arr)
        Debug.Print arr(x)
    Next x
    End Sub
    

    You can also put the collection in an array afterwards and print the results from it.

    Sub Test()
    Dim c As Variant, NB As New Collection
    For Each c In [A1:D10] 'Whatever range to check
        If c <> "" Then NB.Add c
    Next c
    Dim arr(), x
    ReDim arr(NB.Count)
    x = 0
    For Each c In NB
        arr(x) = c
        x = x + 1
    Next c
    For x = 0 To UBound(arr)
        Debug.Print arr(x)
    Next x
    End Sub
    

  • answered 2018-01-11 20:53 Francis

    If anyone is looking for a formula solution, this below has worked for me as well:

    =IFERROR(INDIRECT("SHEET1!"&TEXT(SMALL(IF(SHEET1!$A$33:$H$42<>"",ROW(SHEET1!$A$33:$H$42)*10^4+COLUMN(SHEET1!$A$33:$H$42)),ROWS($A$1:A1)),"R0000C0000"),0),"")
    

    and hit Ctrl+Shift+Enter