Literally - every other time

[Steph]

Hello everybody. I have a seemingly strange problem that I'm hoping someone
can help with. I have a procedure (full code below) that clears cells on
multiple sheets and then copies a formula over the cleared range. The first
time I run the proc., it runs in seconds. The second time, it takes
forever! The third it takes seconds, the fourth it takes forever!
Literally, EVERY OTHER run takes forever! It seems so strange to me....To
be sure, I ran the code 20 times, and the pattern continues...every other
time it takes forever. I posted this question a little while ago without
much background or testing, and I got a few good answers like limit the
ranges that excel is copying to, and be sure the last cell is truly the last
cell of the used range, and turn off autocalc. I applied all suggestions,
with minimal difference.

When I step throgh the code, the parts that are slow are the ClearContents
loop and the PasteSpecial line.

Any ideas what causes a literal every-other-time slowdown?! Thanks in
advance!!!

-Steph


Public frng As Range

Sub Pop_Forecast()

Dim shtarray As Sheets
Dim frng As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
clrarray = Array("Forecast", "LMU", "Kit", "SMLC", "WLG", "SMLC Cab", "Serv
Cab", "Ntwk Kit", _
"TDAX", "EMS", "SCOUT", "Dir Coup")

For Each sh In ActiveWorkbook.Worksheets(clrarray)
sh.Range("A5:EC" & Data.Range("b65536").End(xlUp).Row).ClearContents
Next
Set shtarray = Sheets(Array("LMU", "Kit", "SMLC", "WLG", "SMLC Cab", "Serv
Cab", "Ntwk Kit", _
"TDAX", "EMS", "SCOUT", "Dir Coup"))

shtarray.Select
Sheets("LMU").Activate

'Copy Formula
Range("A2:EC2").Copy

Set frng = Range("A5:EC" & Data.Range("b65536").End(xlUp).Row)

frng.Select
Selection.PasteSpecial Paste:=xlPasteFormulas

Application.Calculation = xlCalculationAutomatic
'Range value detail sheets
' frng.Copy
' frng.PasteSpecial Paste:=xlValues
Application.Calculation = xlCalculationManual

'Consolidate2
Forecast.Range("A5").Consolidate Sources:=Array( _
"'LMU'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) & "C133"
_
, "'Kit'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'SMLC'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'WLG'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'SMLC Cab'!R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'Serv Cab'!R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'Ntwk Kit'!R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'TDAX'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'EMS'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'SCOUT'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
, "'Dir Coup'!R5C5:R" & Format(LMU.Range("A65536").End(xlUp).Row) &
"C133" _
), Function:=xlSum, TopRow:=False, LeftColumn:=True,
CreateLinks:=False

Forecast.Activate
Application.Calculation = xlCalculationAutomatic

'Clear variables

Set shtarray = Nothing
Set clrarray = Nothing
Set sh = Nothing
Set frng = Nothing

Application.ScreenUpdating = True

End Sub