Shifting cells up with VBA

Try this:

Sub syednizamudeen_1()
Dim i As Long, j As Long, n As Long
Dim va, vb

va = Range("B2", Cells(Rows.Count, "B").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If n = 0 And va(i, 1) = "" Then
        n = i
    ElseIf va(i, 1) <> "" Then
        vb(n, 1) = va(i, 1)
        n = 0
    End If
Next
Range("B2").Resize(UBound(va, 1), 1) = vb
End Sub

Originally Posted by Akuini

Try this:

Sub syednizamudeen_1()
Dim i As Long, j As Long, n As Long
Dim va, vb

va = Range("B2", Cells(Rows.Count, "B").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If n = 0 And va(i, 1) = "" Then
        n = i
    ElseIf va(i, 1) <> "" Then
        vb(n, 1) = va(i, 1)
        n = 0
    End If
Next
Range("B2").Resize(UBound(va, 1), 1) = vb
End Sub

Thanks. So handy. Can you explain the code with added comments?? Sorry for asking too much.

Originally Posted by syednizamudeen

Thanks. So handy. Can you explain the code with added comments?? Sorry for asking too much.

Sub syednizamudeen_1()
Dim i As Long, j As Long, n As Long
Dim va, vb

va = Range("B2", Cells(Rows.Count, "B").End(xlUp)) 'load data starting at B2 into array va
ReDim vb(1 To UBound(va, 1), 1 To 1) 'create array vb with the same dimension as va
For i = 1 To UBound(va, 1)
    If n = 0 And va(i, 1) = "" Then 'in col B: get the first blank cell row after non-blank cell & send it to n
        n = i
    ElseIf va(i, 1) <> "" Then 'in col B: if it's non-blank cell
        vb(n, 1) = va(i, 1) 'sent it's value to vb on row n
        n = 0
    End If
Next
Range("B2").Resize(UBound(va, 1), 1) = vb 'put vb values to col B starting at B2
End Sub