Fill down to last row - copy formula to last row

G

Guest

Dear Friends,
Once again I turn to you!
I have a pivot table that will be generating several reports whereas the
columns and rows will change with every selection.
I need to have formulas placed at the end of the columns and copied down to
the last row after page value is changed.
I've got everything to work except for copying the formula down to the last
row (the last line of code is where it's crashing..) see below:

Sub SetUpFormula()

Dim strLstRw As String
strLstRw = ActiveSheet.Range("A65000").End(xlUp).Row


Range("D4").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Rate"
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = _
"=IF(ISERROR(VLOOKUP(" & "B5" & ",Rates,2,FALSE)),"""",VLOOKUP(" &
"B5" & ",Rates,2,FALSE))"
ActiveCell.Offset(-1, 1).Select
ActiveCell.FormulaR1C1 = "Total"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-2]*RC[-1])"

Range(ActiveCell.Offset(0, -1), ActiveCell).Select

Selection.AutoFill Destination:=Range("ActiveCell.Offset(0,
-1):ActiveCell.Offset(" & strLstRw & ", 0)"), Type:=xlFillDefault

End Sub

Please! Can anyone help me??? I need to finish this project today.
 
I

Incidental

Hey Tim

Not sure if this will help you as I'm not entirely sure what it is
you want to do but you could try something like this. It doesn't use
the autofill but I'm sure you could use this code to select the cells
needed for your source and fill ranges.

Sub SetUpFormula()
Dim Rng1 As Range
Range("D4").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Rate"
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=IF(ISERROR(VLOOKUP(" & "B5" &
",Rates,2,FALSE)),"""",VLOOKUP(" & "B5" & ",Rates,2,FALSE))"
ActiveCell.Offset(-1, 1).Select
ActiveCell.FormulaR1C1 = "Total"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-2]*RC[-1])"
Range(ActiveCell.Offset(0, -1), ActiveCell).Copy 'copy formulas
ActiveCell.Offset(0, -2).Select 'move back to the last column
ActiveCell.End(xlDown).Offset(1, 0).Select 'move to the end of that
column
Set Rng1 = Range(ActiveCell, ActiveCell.End(xlDown)) 'select from the
last entry to the last row
Rng1.PasteSpecial xlFormulas 'paste formulas
Application.CutCopyMode = False
End Sub


hope this is of some use to you or at least gives you an idea or two to
try...

laterz

S
 
G

Guest

Thanks!
What I wound up doing was just looping the last two lines until
activecell.row=strLstRw


Incidental said:
Hey Tim

Not sure if this will help you as I'm not entirely sure what it is
you want to do but you could try something like this. It doesn't use
the autofill but I'm sure you could use this code to select the cells
needed for your source and fill ranges.

Sub SetUpFormula()
Dim Rng1 As Range
Range("D4").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Rate"
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=IF(ISERROR(VLOOKUP(" & "B5" &
",Rates,2,FALSE)),"""",VLOOKUP(" & "B5" & ",Rates,2,FALSE))"
ActiveCell.Offset(-1, 1).Select
ActiveCell.FormulaR1C1 = "Total"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-2]*RC[-1])"
Range(ActiveCell.Offset(0, -1), ActiveCell).Copy 'copy formulas
ActiveCell.Offset(0, -2).Select 'move back to the last column
ActiveCell.End(xlDown).Offset(1, 0).Select 'move to the end of that
column
Set Rng1 = Range(ActiveCell, ActiveCell.End(xlDown)) 'select from the
last entry to the last row
Rng1.PasteSpecial xlFormulas 'paste formulas
Application.CutCopyMode = False
End Sub


hope this is of some use to you or at least gives you an idea or two to
try...

laterz

S

Dear Friends,
Once again I turn to you!
I have a pivot table that will be generating several reports whereas the
columns and rows will change with every selection.
I need to have formulas placed at the end of the columns and copied down to
the last row after page value is changed.
I've got everything to work except for copying the formula down to the last
row (the last line of code is where it's crashing..) see below:

Sub SetUpFormula()

Dim strLstRw As String
strLstRw = ActiveSheet.Range("A65000").End(xlUp).Row


Range("D4").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Rate"
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = _
"=IF(ISERROR(VLOOKUP(" & "B5" & ",Rates,2,FALSE)),"""",VLOOKUP(" &
"B5" & ",Rates,2,FALSE))"
ActiveCell.Offset(-1, 1).Select
ActiveCell.FormulaR1C1 = "Total"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-2]*RC[-1])"

Range(ActiveCell.Offset(0, -1), ActiveCell).Select

Selection.AutoFill Destination:=Range("ActiveCell.Offset(0,
-1):ActiveCell.Offset(" & strLstRw & ", 0)"), Type:=xlFillDefault

End Sub

Please! Can anyone help me??? I need to finish this project today.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top