Code to delete all empty cells in a range (shift left)

[kidwispa]

Hi All,

I'm trying to run a macro that deletes all empty cells in range C1:DX24719) and shifts left but having used this code :

Sub DeleteCells()
Range("C1:H6").SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft
End Sub

However this takes ages and has so far made Excel hang for about 20 mins...

How can I speed it up and why is it so slow?

Thanks for any help (again!)

 

[shg]

That's 3M cells, and Excel has to adjust formulas for all that survive.

You might try setting calculation to manual and disabling screen updating, but I wouldn't expect any miracles.

 

[kidwispa]

That's 3M cells, and Excel has to adjust formulas for all that survive.

You might try setting calculation to manual and disabling screen updating, but I wouldn't expect any miracles.

There aren't any formulas in the range given - what I have is a grid where as few as 1 and as many as 26 cells in each row of the range have either 1 or 2-digit numbers - rather than have big gaps throughout I'm trying to get the information to read left to right...

 

[kidwispa]

bump

 

[shg]

This runs in a few seconds, but assumes there are no formulas in the cells.

Sub DeleteCells()
    Dim av          As Variant
    Dim iRow        As Long
    Dim jRead       As Long
    Dim jWrit       As Long
 
    With Range("C1:DX24719")
        av = .Value
        For iRow = 1 To .Rows.Count
            jWrit = 1
            
            For jRead = 1 To .Columns.Count
                If Not IsEmpty(av(iRow, jRead)) Then
                    av(iRow, jWrit) = av(iRow, jRead)
                    If jRead <> jWrit Then av(iRow, jRead) = Empty
                    jWrit = jWrit + 1
                End If
            Next jRead
        Next iRow
 
        .Value = av
    End With
End Sub

 

[kidwispa]

That was exactly what I was looking for - thanks shg!