使用 Excel VBA 从包含空单元格的列中收集数字

Question

I have a little problem, I occasionally bump into this kind of problem, but I haven't found a fast solution so far.

So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column 'A' with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:

3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2

Now in the next step I would like to collect these numbers into another column (for example, column 'B') using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:

3
6
4
23
2

I have already written the following code, but I'm stuck at this point.

Sub collect()
For i = 1 To 10
    if cells(i,1)<>"" then...
Next i
End Sub

Is there an easy way to solve this problem?

Answer 1

Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:

The VBA equivalent is

Sub test()

    With Sheet1
        .Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
            "D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
    End With

End Sub

Answer 2

You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.

Edit: needed constants not formulas.

Answer 3

If you wish to loop manually and don't mind specifying the maximum row limit;

Dim i As long, values As long

For i = 1 To 10
    If cells(i, 1).Value <> "" Then
        values = (values + 1)
        ' // Adjacent column target
        cells(values, 2).value = cells(i, 1).value
    End If
Next i

Answer 4

This will work for any number of rows that you select. It will always output in the next column at the start of your selection eg if data starts in B10 it will ooutput in C10

Sub RemoveBlanks()
    Dim cl As Range, cnt As Long
    cnt = 0

    For Each cl In Selection
        If Not cl = vbNullString Then
            Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
            cnt = cnt + 1
        End If
    Next cl
End Sub