CODEWITHSUNDEEP
vbaexcelscripting
diggy
diggy

Reputation: 21

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

Upvotes: 1

Views: 1911

Answers (4)

Dick Kusleika
Dick Kusleika

Reputation: 33155

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

Upvotes: 0

Reafidy
Reafidy

Reputation: 8441

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.

Upvotes: 0

Lance Roberts
Lance Roberts

Reputation: 22842

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

Upvotes: 0

Jay
Jay

Reputation: 57939

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

Upvotes: 1

Related Questions