excel vba - remove cell from a variant based on blank in another column

i have an excel sheet like so:

HEADING <--A1           HEADING  <-- this is B1
dhg                     kfdsl
56                      fdjgnm
hgf                     fdkj
tr
465                     gdfkj

gdf53
ry                      4353
654                     djk

354 <-- a12                      blah开发者_高级运维     <-- this is B12

I'm trying to put the range of cells in column A into a variant and remove any data from that variant if the cell in column B (for the same row in column A) is blank. Then i want to copy that variant to a new column (ie col c)

so my expected result is:

HEADING <--C1           
dhg                     
56                      
hgf                     
465                     
ry                      
654                     
354 <-- C8          

this is the code i have so far:

    Dim varData As Variant
    Dim p As Long

varData = originsheet.Range("B2:B12")

                For p = LBound(varData, 1) To UBound(varData, 1)                   
                    If IsEmpty(varData(p, 1)) Then
                        remove somehow
                    End If
                Next p

Dim bRange As range
Set bRange = originsheet.range("B2:B12")

Dim aCell, bCell, cCell As range
Set cCell = originsheet.Cells(2, 3) 'C2
For Each bCell In bRange
    If bCell.Text <> "" Then
        Set aCell = originsheet.Cells(bCell.Row, 1)
        cCell.Value2 = aCell.Value2
        Set cCell = originsheet.Cells(cCell.Row + 1, 3)
    End If
Next bCell

Personally, I think your making this simple job harder, but here's how to do it the way you wanted:

Public Sub Test()

Dim Arange As Variant, Brange As Variant, Crange() As Variant
Dim i As Integer, j As Integer

Arange = Range("A2:A12")
Acount = Application.WorksheetFunction.CountA(Range("B2:B12"))
Brange = Range("B2:B12")
j = 1
ReDim Crange(1 To Acount, 1 To 1)
For i = 1 To UBound(Arange)
  If Brange(i, 1) <> "" Then
    Crange(j, 1) = Arange(i, 1)
    j = j + 1
  End If
Next i

Range("C2:C" & j) = Crange
End Sub

Try:

  With ActiveSheet.UsedRange
        .Cells(2, "C").Resize(.Rows.Count).Value = Cells(2, "A").Resize(.Rows.Count).Value
        .Cells(2, "B").Resize(.Rows.Count).SpecialCells(xlCellTypeBlanks).Offset(, 1).Delete shift:=xlUp
  End With

EDIT:

This is better:

With Range("A2", Cells(Rows.Count, "A").End(xlUp))
   Cells(2, "C").Resize(.Rows.Count).Value = .Value
   .Offset(, 1).SpecialCells(xlCellTypeBlanks).Offset(, 1).Delete shift:=xlUp
End With

You could also do it with advanced filter and no VBA.

Sub Main()

    Dim rValues As Range
    Dim vaIn As Variant
    Dim vaTest As Variant
    Dim aOut() As Variant
    Dim i As Long
    Dim lCnt As Long

    Set rValues = Sheet1.Range("A2:A12")
    vaIn = rValues.Value
    vaTest = rValues.Offset(, 1).Value
    ReDim aOut(1 To Application.WorksheetFunction.CountA(rValues.Offset(, 1)), 1 To 1)

    For i = LBound(vaIn, 1) To UBound(vaIn, 1)
        If Len(vaTest(i, 1)) <> 0 Then
            lCnt = lCnt + 1
            aOut(lCnt, 1) = vaIn(i, 1)
        End If
    Next i

    Sheet1.Range("C2").Resize(UBound(aOut, 1)).Value = aOut

End Sub