Alternate to loop and copy formulas

[JackDanIce]

Hi,

I have a header row with a mixture of constants and formulas; using cell formatting to mask formulae (Formula bar visible). This row is 228 columns wide, and has a fixed pattern of 3 columns with formula, 16 columns constant values x 12

The whole header range is named: Main_Formula

I use following to copy formula and apply to rows below but it is slow:

Sub Apply_Formulas(byref LR as Long)

Dim r as Range
Dim rng as Range: set rng = Range("Main_Formula").Specialcells(xlcelltypeFormulas)

With Application
  .ScreenUpdating = False
  .CalculationMode = xlCalculationManual
End With

For Each r in Rng
  r.Copy
  r.Offset(1).Resize(LR - 1).PasteSpecial xlPasteFormulas
Next r

With Application
  .CutCopyMode = False
  .ScreenUpdating = False
  .CalculationMode = xlCalculationManual
End With

Set rng = Nothing

End Sub

I tried something like:
[/code]
With rng
.Copy
.Resize(LR).PasteSpecial xlPasteFormulas
End With
[/code]
But this gave run time 1004 error, suggesting I'm not defining the paste range correctly?


Any suggestions for faster code?

TIA,
Jack

 

[Fluff]

You cannot resize non-contiguous ranges. Try

For Each r In Rng
  r.Resize(Lr).FillDown
Next r

 

[JackDanIce]

Suspected so, thanks for confirming @Fluff and your suggestion is a little faster than what I had.

 

[Fluff]

You're welcome & thanks for the feedback