PDA

View Full Version : Solved: Loop To Populate Formula



bradh_nz
08-23-2007, 04:54 AM
Hello

I have a formula that takes to long to calculate for an entire workbook (crashs workbook).
I though I could loop through selected cells copying the formula into the cell, calculating, copy and paste as values and move onto the next however I cannot seem to get it to work. Here is my attempt.

Sub Insert_Formulas()

Sheets("Detailed analysis").Select
Dim C As Range

'Loop format pivot table borders
Range("H8:L32").Select

For Each C In Selection.Cells
ActiveCell.FormulaR1C1 = "=VLOOKUP(R5C,INDIRECT.EXT(""'""&RC5),3,FALSE)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Interior.ColorIndex = 15
Next C
End Sub

Bob Phillips
08-23-2007, 05:04 AM
Nothing obvious that I can see, but I have to ask why you precede R5 with an apostrophe in the value passed to INDIRECT.EXT.

I assume you have installed that addin.

bradh_nz
08-23-2007, 05:12 AM
Yes that addin has been installed

mdmackillop
08-23-2007, 05:21 AM
Hi,
There is only one ActiveCell in the range, so the code writes to that cell repeatedly. Write the formula to C instead.

Sub Insert_Formulas()
Dim C As Range
'Loop format pivot table borders
Range("H8:L32").Select
For Each C In Selection.Cells
C.FormulaR1C1 = "=VLOOKUP(R5C,INDIRECT.EXT(""'""&RC5),3,FALSE)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Interior.ColorIndex = 15
Next C
End Sub


Alternatively, you don't need to loop.

Sub Insert_Formulas2()
With Range("H8:L32")
.FormulaR1C1 = "=VLOOKUP(R5C,INDIRECT.EXT(""'""&RC5),3,FALSE)"
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Interior.ColorIndex = 15
End With
End Sub

Bob Phillips
08-23-2007, 05:32 AM
Doh! How did I miss that?

bradh_nz
08-23-2007, 05:50 AM
Sorry one more question is it possible to get this to work on multiple range, ie

Range("G6:W79,Z6:AD79").Select

Thanks