PDA

View Full Version : Solved: macro to fill empty cells (by copy/paste)



tolio
12-23-2007, 03:19 AM
Hi people,

Just starting in VBA :bug:

I have a sheet with a dynamic range.
The first column has some empty cells that i want to fill based on the value of the upper cell.


For example i have:

A1:textA
A2:empty cell
A3:empty cell
A4: textB
A3:empty cell
A3:textC

And i want to have:
A1:textA
A2:textA
A3:textA
A4:textB
A3:textB
A3:textB

I have the following code, but it seems to fail; i select the range and run the macro but it doesn't update all the cells. Another problem is that i have to pre-select the cells, is there a way to turn this more automatic defining a dynamic range?


Sub Fillrow()
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False
For i = 1 To Rng
If ActiveCell.Value = "" Then
ActiveCell.Offset(-1, 0).Copy
ActiveSheet.Paste
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Application.ScreenUpdating = True
End Sub


Best regards,
tolio

francis
12-23-2007, 04:25 AM
Hi

You don't need a macro. follow the steps below :
Make a selection (Multiple columns and rows, for instance)
F5 Special, goto blanks
in the formala bar add =A1 ( assuming your data start from cell A1 )
then press Ctrl + Enter

hope this help.

cheers

tolio
12-23-2007, 07:21 AM
Hi Francis,

Thx for the clever solution.
I still need to use this in VBA, but now i have the code:

Range("B65536").End(xlUp).Offset(0, -1).Select
Selection.SpecialCells (xlCellTypeBlanks)
Selection.FormulaR1C1 = "=R[-1]C"



I use column B as a reference.
The problem is that this code only fills the last cell in column A.

I need to run it on all the cells of column A till the end.

Something like this would do the trick i think:


FinalRow = Range("B65536").End(xlUp)
Range("B1:Finalrow").Offset(0, -1).Select
Selection.SpecialCells (xlCellTypeBlanks)
....


But it doesn't work :dunno
Any help on how i can select this dynamic range?

thx
tolio

lucas
12-23-2007, 09:20 AM
This might work:
Option Explicit
Sub FillColBlanks()
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("A1").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.FormulaR1C1 = "=R[-1]C"
End If
'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With
End With
End Sub

mikerickson
12-23-2007, 11:24 AM
Range(oneCell,twoCell)
refers to the rectangular range bounded by oneCell and twoCell.
Adding that to tolio's code and eliminating the selection gives


With ThisWorkbook.Sheets("Sheet1")
With Range(.Range("b1"), .Range("b65536").End(xlUp))
.Offset(0, -1).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
End With
End With

Putting it inside On Error Resume Next / On Error Goto 0 will prevent crashing when there are no blank cells, like when happens when the user runs the routine twice.

tolio
12-24-2007, 06:04 PM
Thx,

Works like a charm!

Merry Xmas all