CODEWITHSUNDEEP
excel
Francis
Francis

Reputation: 129

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

Upvotes: 0

Views: 1465

Answers (2)

Francis
Francis

Reputation: 129

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

Upvotes: 0

user1274820
user1274820

Reputation: 8144

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

Upvotes: 1

Related Questions