ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Insert Formula and Copy to other cells (https://www.excelbanter.com/excel-discussion-misc-queries/40131-insert-formula-copy-other-cells.html)

[email protected]

Insert Formula and Copy to other cells
 
Hello,
I need help fast! I need to be able to insert a Formula into rows that
contain certain text. I then need to be able to copy all this formula
across 15 columns and down to the end of the active workbook for each
row that contains this criteria. I want the formula to automatically
update to the correct cell reference. My formula is rather lengthy but
it works perfectly in a 'normal' spreadsheet without running a macro.

This is what I have:

Dim intx as Integer
Dim lngrow as long

ActiveCell.SpecialCells(xlLastCell).Select
lngrow = ActiveCell.Row 'lastcell in spreadsheet

For intx = 1 To lngrow
Cells(intx, 1).Select
If InStr(1, ActiveCell.Value, " Target Renewal") 0
Then
Range(Cells(intx, 6), Cells(intx, 20)).Select
Selection.Formula =
"=IF(AND(OR($D$2=30,$D$2=60),D15=""aprent"")," -
",IF(OR(E19=$B$2*(1-($D$2/30)),E19=$B$2*(1-(($D$2-30)/30)),E19=$B$2*(1-(($D$2-60)/30)),E19=$B$2*(1-(($D$2-90)/30)),E19=$B$2),$B$2,IF((F15+$D$2)<30,$B$2*(1-($D$2/30)),IF(OR(D15=""aprent"",F150),"
- ",IF((F15+E15+$D$2)<60,$B$2*(1-(($D$2-30)/30)),IF(D19=""," -
",IF((D15+E15+F15+$D$2)<90,$B$2*(1-(($D$2-60)/30))," - ")))))))"
End If
Next

Any help is appreciated. Thanks!


Dave O

How about this:
Sub YourCodeName()
Range("a1").Select '<-- The cell that contains the formula you need to
copy
Selection.Copy '<--copy into clipboard

For intx = 1 To lngrow '<--start your For loop as usual
Cells(intx, 1).Select
If InStr(1, ActiveCell.Value, " Target Renewal") 0 Then
Range(Cells(intx, 6), Cells(intx, 20)).Select
ActiveSheet.Paste
Endif
Next Intx

.... or something like that?



All times are GMT +1. The time now is 10:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com