Inefficient Space Removal

[Sauron]

Hi There,

I have recently cobbled together some code to strip out empty cells
from a row of information, unfortunately it runs extremely slowly,
could anyone suggest a way of making this following code more efficient
so it doesen't take 2mins+ to run?

Sub RemEmptyFinal()

Application.ScreenUpdating = False
Dim rng As Range, ix As Long

'Sheet1
Sheets("AOwens").Select
Sheet1.Range("W2:W1000").Select
Selection.Copy
Sheet1.Range("U2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
True, Transpose:=False
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
If rng Is Nothing Then
GoTo done
End If
-For ix = rng.Count To 1 Step -1
If Len(Trim(Replace(rng.Item(ix).Formula, Chr(160), ""))) _
= 0 Then rng.Item(ix).Delete (xlUp)-

Sheet1.Range("A1").Select

Next


~*~*~*

Thanks all, I am extremely grateful for any suggestions.

Sau

 

[Tom Ogilvy]

Take out the

Sheet1.Range("A1").Select

 

[Tom Ogilvy]

also, Turn calculation to manual.

 

[Chris Leonard]

Try this.

Sub DeleteBlanks()
Range("A1:A20").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub

I'll admit it's not my work, I was using a loop method but someone else
suggested this as a better alternative.

HTH

Chris

 

[Tom Ogilvy]

Excel doesn't view a cell with Chr(160) as blank, so I doubt this will work
as a general solution.

 

[Sauron]

Cheers for the quick responses!

Thanks Chris I tried using your code but it didn't work never mind
I'll just have to keep on the lookout for a better way.

I tried what you said Tom and I think I am getting a slight decrease in
the time taken but its still taking 1min+ unfortunately...

Never mind, it still beats doing it manually!

Thanks again,
Sau