collect numbers from a column containing empty cel

Question

I have a little problem, I occassionally 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 (eg. 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?

Thanks in advance,

Laszlo

Answer 1

Probably the quickest and easiest way is to use Excel's Advanced Filter - the only ammendment 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

If you wish to loop manually & 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 ff
next i

Answer 3

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 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 e.g. 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