Populate one cell with an offset cells contents

[Fleone]

Here is what I would like to do in a Macro using Excel 2007.
Search a column of data. Where the first blank cell occurs, look in the cell
above it and copy the data down. This would continue through a range of
cells, or the entire column. I know that I can probably accomplish this
through the use of VLookup and copy/paste but the number of entries that
might be copied could range from a few to a few hundred.
I came up with this (it made sense to me <G>) and it doesn't even come close
to working.
Assume that column C has the letters A, B, C, and D in Cells C1, C5, C10,
and C15.
I would like to see the letter A in cells C1:C4, B in C5:C9, C in cells
C10:C14 and D in cells C15:C (the end of the range)

Sub Test ()

For Each cell In Range("C:C")
If cell.Value = "" Then
ActiveCell.Offset(1).Copy
ActiveCell.Paste

End If
Next
End Sub

The result is that the macro is trapped in a loop and hangs Excel forcing a
restart of the application.

 

[Gord Dibben]

You don't need a macro to do this but here is one from Dave Peterson.

Sub Fill_Blanks()
'by Dave Peterson 2004-01-06
'fill blank cells in column with value above
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long

Set wks = ActiveSheet
With wks
col = ActiveCell.Column
'or
'col = .range("b1").column

Set rng = .UsedRange 'try to reset the lastcell
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.NumberFormat = "General"
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With

End With

End Sub


Gord Dibben MS Excel MVP

 

[Fleone]

Thanks Gord! It works exactly as I would have hoped.
I was just missing about 30 lines of code <G>!

You don't need a macro to do this but here is one from Dave Peterson.

Sub Fill_Blanks()
'by Dave Peterson 2004-01-06
'fill blank cells in column with value above
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long

Set wks = ActiveSheet
With wks
col = ActiveCell.Column
'or
'col = .range("b1").column

Set rng = .UsedRange 'try to reset the lastcell
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.NumberFormat = "General"
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With

End With

End Sub


Gord Dibben MS Excel MVP

Here is what I would like to do in a Macro using Excel 2007.
Search a column of data. Where the first blank cell occurs, look in the cell
above it and copy the data down. This would continue through a range of
cells, or the entire column. I know that I can probably accomplish this
through the use of VLookup and copy/paste but the number of entries that
might be copied could range from a few to a few hundred.
I came up with this (it made sense to me <G>) and it doesn't even come close
to working.
Assume that column C has the letters A, B, C, and D in Cells C1, C5, C10,
and C15.
I would like to see the letter A in cells C1:C4, B in C5:C9, C in cells
C10:C14 and D in cells C15:C (the end of the range)

Sub Test ()

For Each cell In Range("C:C")
If cell.Value = "" Then
ActiveCell.Offset(1).Copy
ActiveCell.Paste

End If
Next
End Sub

The result is that the macro is trapped in a loop and hangs Excel forcing a
restart of the application.