Fill down to last row - copy formula to last row
 

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.

Fill down to last row - copy formula to last row
 

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


TimT wrote:

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.

Fill down to last row - copy formula to last row
 

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


"Incidental" wrote:

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


TimT wrote:

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.