Performance running ClearContents is very slow when WrapText is enabled in Excel

Question

I'm debugging the following code in an Excel 2007 VBA, which seems very simple. For some reason its taking about 30 minutes to process 900 rows of data. I think I have narrowed it down to some cell formatting, specifically the WrapText option. Is there something I'm missing here that can increase the performance when deleting these rows.

Sub ClearContentsOfActive()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim NumLines
    NumLines = ActiveSheet.UsedRange.Rows.Count

    Range("2:" & NumLines + 3).Select
    Selection.ClearContents
    Selection.Delete Shift:=xlUp

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Additionally, The user was not experiencing these delays in Excel 2003, with the same code. Thanks in advance

Update

In response to the redundancy of the ClearContents line, this is the original code that was working in Excel 2003, thats why I left it. Commenting this line was one of the first things I tried, as I agreed that it may've been redundant. See below for my psuedo perfomance metrics.

Test1

Selection.ClearContents  ''//  Takes ~30 mins
Selection.Delete Shift:=xlUp  ''// then this takes <1min

Test2

'Selection.ClearContents  '// If this line is commented
Selection.Delete Shift:=xlUp  ''// then this line takes ~30 mins

The reason I believe it has something to do with the WrapText feature is because when you clear the line of WrapText it performs and AutoFit operation on the row. I thought that hiding screen updates or disabling events would help.

Answer 1

Is it actually necessary to call .ClearContents before calling .Delete? It seems to me that the call to .ClearContents is redundant. You're emptying the values in a range of cells that you simply remove from existence in the very next line.

I don't know if that will help with the performance issue, but it is worth a shot.

edit: In response to your update, how about avoiding the selction, and just doing the following:

Range("2:" & NumLines + 3).Delete shift:=xlUp

You can also try to get rid of the text wrapping ahead of time:

Range("2:" & NumLines + 3).WrapText = False
Range("2:" & NumLines + 3).Delete shift:=xlUp

Answer 2

So it seems to be related to the ColorIndex property of the cells and not the WrapText Feature. The Macro for the page had the following code

For r = 0 to 1000
  For c = 0 to 15
    Sheets.Cells(r, c).ColorIndex = 14
  Next c
Next r

I recommended that the user uses ConditionalFormatting, junking the macro all together and that fixed his performance issues.

ConditionalFormatting was based on a formula on the entire sheet that turned the yellow if the following evaluated to true

=IF(ROW()>10, FALSE, LEN($A1)>0)