Fill/Copy Up to fill blank cells.

[J.W. Aldridge]

I have a list of data in column B. Every few lines there is a blank.
In any instance of a blank cell, I want a code that will copy from the
value from the cell below and paste it into the blank cell.

The opposite of the fill/copy down code that would copy the last
value.

ex:
apples
cherries
blueberries

plums
mangos
kiwi

Desired result:

apples
cherries
blueberries
plums
plums
mangos
kiwi

The code found plums below the blank space so it copies and plugs that
value in.

 

[Sean Timmons]

Easy nuf..

In the first blank, type = and hit the down arrow.. creates the reference.

copy this cell, highlight the column..
Edit - Go to - Special - Blanks
Paste
Ta-Da!

 

[Gord Dibben]

Sub Fill_Blanks_From_Below()
Dim rng As Range, ar As Range
Set rng = Columns(2).SpecialCells(xlBlanks)
For Each ar In rng.Areas
ar.Value = ar.Offset(1, 0).Value
Next ar
End Sub

You can do this manually

Select the column then F5>Special>Blans>OK

Type an = sign in active blank cell. point or arrow down to cell below and
Hit CTRL + ENTER


Gord Dibben MS Excel MVP

 

[timmg]

I had a similar problem last week, only I needed to copy from the cell
above to the blank cells below. Perhaps you can modify this code to
your purposes. Likewise, I'd welcome any suggestions for
improvements.

Sub Copy_down2()
'Copy cell above to current cell and empty cells below
' make the range wider by adjusting the column offset, where 0 =
current
Dim rng_frm As Range, rng_to As Range, intCO As Integer, intLC As Long

intCO = 0 ' column offset
intLC = ActiveSheet.Rows.Count

Do While ActiveCell.Row < intLC
If IsEmpty(ActiveCell) Then
Set rng_frm = Range(Cells(ActiveCell.Row - 1,
ActiveCell.Column).Address _
& ":" & Cells(ActiveCell.Row - 1, ActiveCell.Column +
intCO).Address)
Set rng_to = Range(Cells(ActiveCell.Row,
ActiveCell.Column).Address _
& ":" & IIf(IsEmpty(ActiveCell(2)),
(Cells(ActiveCell.End(xlDown).Row - 1, ActiveCell.Column).Address),
(Cells(ActiveCell.Row, ActiveCell.Column).Address)))

rng_frm.Copy rng_to
Cells(ActiveCell.End(xlDown).Row,
ActiveCell.Column).Select
End If
ActiveCell(2).Select
If ActiveCell.End(xlDown).Row = intLC Then
Exit Sub
End If

Loop

End Sub