copy and paste active cell down a column

[andytpl]

I like to create a macro that can automate the process of copying the active cell downward as long as the column D is not empty bearing in mind that there maybe empty rows in column D. It has to be intelligent enoug to skip empty rows.

[Bob Phillips]

[vba]

ActiveCell.Copy Activecell.Resize(Cells(Rows.Count,"D").End(xlUp).Row)
[/vba]

[andytpl]

The macro is copying down as what I want to but I did not make it clear enough that if cell in column D is empty the corresponding cell in the active column should also be empty.

[Bob Phillips]

Maybe this

[vba]

With ActiveCell

.Offset(1, 0).Resize(Cells(Rows.Count, "D").End(xlUp).Row).FormulaR1C1 = _
"=IF(RC4="""","""",R" & .Row & "C)"
End With
[/vba]

[andytpl]

I don't know what I am doing wrong, I could not get the result I want. While executing the code there is a circular reference error. Secondly only the cell below the active cell is copied but the content is not as the active cell. The data is the copied cell is "=IF($D2="","",D$1)". ???

[Bob Phillips]

Which is the activecell when you run it?

[andytpl]

My mistake. I have it the other way around. It is now working. thx

[andytpl]

I spoke too fast. Although now the code is copying down the active cell but instead of copying the content of the active cell this is copied, "=IF($D2="","",D$1)"

[Bob Phillips]

But isn't the result the value of the activecell?

[Bob Phillips]

I also ask again, what is the activecell when you run this?

[andytpl]

No, the active cell have a different value. The formula is Cell A1 (the active cell) is E1+F1

[Bob Phillips]

E1+F1 is two cells, there is only one activecell.

It must be me, but you guys are really confusing me today.

Here is another suggesrion

[vba]

Dim LastRow As Long
Dim rng As Range
With ActiveCell

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = .Resize(LastRow).SpecialCells(xlCellTypeBlanks)
.Copy .Resize(LastRow)
rng.ClearContents
End With
[/vba]

[andytpl]

Sorry, the active is A1 which has a formula of E1+F1.

[Bob Phillips]

Modification of my last offering then

[vba]

Dim LastRow As Long
Dim rng As Range
With ActiveCell

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Cells(.Row + 1, "D").Resize(LastRow).SpecialCells(xlCellTypeBlanks).Offset(0, .Column - 4)
.Copy .Resize(LastRow)
rng.ClearContents
End With
[/vba]

[andytpl]

Thx. It now appears to be working the way I hope it would.

[andytpl]

Thx. It now appears to be working the way I hope it would.

[Bob Phillips]

Great, we finally got there :smile

[andytpl]

Xld,

I wonder if you could help to improve on this macro. At the present moment this macro is very specific as to the reference "criteria" position, which is to the 4 position to the right of the active cell. What should the codes be if it to the right? Can a input box be created to ask for input of the reference cell? That will be wonderful if this can be done.

Thx in advance for any suggestionn and help.

[Bob Phillips]

Try this

[vba]

Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range

Set StartCell = Application.InputBox("Select first cell of match range with the mouse", Type:=8)
If Not StartCell Is Nothing Then

With ActiveCell

LastRow = Cells(Rows.Count, StartCell.Column).End(xlUp).Row
.Offset(1, 0).Resize(LastRow - 1).ClearContents
Set rng = Cells(.Row + 1, StartCell.Column).Resize(LastRow).SpecialCells(xlCellTypeBlanks).Offset(0, .Column - StartCell.Column)
.Copy .Resize(LastRow)
rng.ClearContents
End With
End If
[/vba]

[andytpl]

Xld,

The same problem as before. When pasting down the active cell it is suppose to skip over blank reference cell and continue pasting when the reference cell is not empty. Hope I make sense.