Dragging down multiple cells until last adjacent row vba

[biertje]

I have been a long time lurker and this forum has been a huge help. However, I have now come across a problem which I can't seem to fix.

A quick explanation of my problem:
In column A I have a list of names, the length of which changes every week. In column B and C I have 2 formulae and in column D I have a formula which sits in two cells. Everytime I run my macro it deletes columns A:D and pastes in the new names into A it then fills in B1 and C1 with the formulae and drags it down until the last row of A. Simple enough. However my formula in D needs to be dragged down across 2 cells i.e. D1:D2.

My code is:

Sub FillDown()'
'Copies the formulae in D1:D2 and copies it down to the last filled in row in column A.
'
Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("d1:d2").Copy Range("d3:d", Cells(Rows.Count, "A").End(xlUp).Offset(0, 3))
End Sub

This only inserts the formula into B3:B4 and doesn't fill down to the last row in A.

I have also tried

Sub Drag_Formula_Error()'
'Fills in the error formula in column D to the last filled cell in A
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("D1").AutoFill Destination:=Range("D1:D" & lastRow)


End Sub

but this just drags down the formula from D1. Is there a way to combine the two?

Grateful for any help.

 

[Fluff]

Give this a go.

Sub FillDown() '
'Copies the formulae in D1:D2 and copies it down to the last filled in row in column A.
'
Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("d1:d2").Copy Range("d3:d" & lastRow)
End Sub

I'm not sure if it's what you want.

 

[biertje]

Thanks. Unfortunately that has kept the same problem.I am trying to match people in pairs as they go down the list. So A1 is paired with A2, A3 with A4 etc etc. However I don't want to pair people that are in the same team. so if the team matches then it returns an error.

In B1 I have =IFERROR(C1=C2,error) and in B2 I have =B1.

The following table just much longer:



[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B`[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]Team 1 Fred[/TD]
[TD]Random number[/TD]
[TD]Team 1[/TD]
[TD]=IFERROR(C1=C2,error)[/TD]
[/TR]
[TR]
[TD]Team 1 Alice[/TD]
[TD]random number[/TD]
[TD]Team 1[/TD]
[TD]=D1[/TD]
[/TR]
[TR]
[TD]Team 2 Jess[/TD]
[TD]random number[/TD]
[TD]Team 2[/TD]
[TD]=IFERROR(C3=C4,error)[/TD]
[/TR]
[TR]
[TD]Team 3 John[/TD]
[TD]random number[/TD]
[TD]Team 3[/TD]
[TD]=D3[/TD]
[/TR]
</tbody>[/TABLE]

So Fred and Alice can't be matched as they are both in team 1, but John and yes can. So it keeps randomly ordering the names until there are no matches.

I guess the other way to do it would be to copy D1 and skip a row each time until the last row.

 

[Fluff]

Can you please explain, why the code I supplied doesn't work?
You asked for something that would copy 2 formulae downwards, in your small table above, you are asking for the same thing.
That is what the code I supplied should do.

 

[biertje]

Fluff thank you for the swift response. I'm not sure what I am doing wrong, but the code only copies D1:D2 into the next two rows. It doesn't copy it down to the last row of the empty cell in the adjacent column as the code says. It's very confusing and I'm not sure what I'm missing.

 

[biertje]

Sorry, just to add that Column A currently has rows 1 - 22 filled in. Does it make a difference that A - C are all formulae too?

 

[Fluff]

If you run this, a message box will pop up, telling you what the lastrow number is.
Is it correct?

Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox lastRow
    'Range("d1:d2").Copy Range("d3:d" & lastRow)
End Sub

PS it won't fill down the formulae

 

[biertje]

Fluff. I just recopied in the formula and it now seems to be working perfectly. No idea what was happening before. Thanks for you help.

 

[Fluff]

Glad to help & thanks for the feedback