Shifting blank cell to left in XL 2003

[Cachilupi]

I have about 14,000 lines of data, each row contains only one cell of data, but the data can be in various columns such as A1, D2, E3, C4, A5, F6, etc.

I am trying to move all the values to the left so that all the data is in the far left column. Is there a way to delete all the blank cells before the data and move the data to the left (all to column A)? I am using XL 2003 and Windows XP.

Thanks!

 

[tmcfadden]

Try this routine:

Sub DeleteLeadingCells(ByVal rng As Range)
Dim rngDelete As Range
For Each cell In rng
    If (cell = "") Then
        Set rngDelete = Range(cell, cell.End(xlToRight).Offset(0, -1))
        rngDelete.Delete xlShiftToLeft
    End If
Next cell

End Sub

You'd call it like so:

call DeleteLeadingCells(sheet1.Range("A1:A19"))

This will delete all of the empy cells starting at column A and working to the right.

-Tim

 

[Cachilupi]

I think that works great, however since I don't know much about how to "call" a macro I modified the code like this:

Sub DeleteLeadingCells() '(ByVal rng As Range)
Dim rngDelete As Range
Set rngDelete = Worksheets("sheet1").Range("a1:I4788")
For Each cell In rngDelete
If (cell = "") Then
Set rngDelete = Range(cell, cell.End(xlToRight).Offset(0, -1))
rngDelete.Delete xlShiftToLeft
End If
Next cell

End Sub

This works great, except about line 2400 it stops working and the Macro continues to run, even though the data set is the same as what worked one line above. If I manually step through it I get a Runtime 13 error.

 

[erik.van.geit]

Hi,

14000 lines ?
if you are removing 14000*"unknown number" one by one having to shift everything to the left each time, your code will be very slooow, I think

faster would be

SpecialCells(xlCellTypeBlanks).Delete

this way you take them all at once
as there is a restriction in the number of "areas" this feature can handle and as this too is rather "heave"use, you could loop per 1000 (or less) rows

Sub test()
Dim i As Long
Dim LR As Long
Dim LC As Integer


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'fill with testdata
    'For i = 1 To 10000
    'Cells(i, Int(Rnd * 256) + 1) = 1
    'Next i

LR = Cells.Find("*", [A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
LC = Cells.Find("*", [A1], xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column

    For i = 1 To LR Step 1000
    Range(Cells(i, 1), Cells(i + 1000, LC)).SpecialCells(xlCellTypeBlanks).Delete xlToLeft
    Next i
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

even this code is not very quick - else it's my machine which is running to much processes

there might be some faster ways
are these data numbers or strings ?

kind regards,
Erik

 

[erik.van.geit]

nevermind
this is satisfying

Option Explicit

Sub shift_all_to_left()
'Erik Van geit
'061013

'all data to column A

Dim LR As Long
Dim LC As Integer
Dim rng As Range
Dim i As Long
Dim j As Integer
Dim arrRng As Variant
Dim arrCol As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'fill with testdata
    'For i = 1 To 10000
    'Cells(i, Int(Rnd * 256) + 1) = Rnd
    'Next i
    'Beep


LR = Cells.Find("*", [A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
LC = Cells.Find("*", [A1], xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column

Set rng = Range(Cells(1, 1), Cells(LR, LC))

arrRng = rng.Value

ReDim arrCol(1 To LR, 0)

    For i = 1 To LR
        For j = 1 To LC
            If arrRng(i, j) <> vbNullString Then
            arrCol(i, 0) = arrRng(i, j)
            Exit For
            End If
        Next j
    Next i
    
'ThisWorkbook.Save
Columns(1).ClearContents
rng.Resize(, 1) = arrCol
Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).Delete

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

for more info about this technique see http://puremis.net/excel/code/053.shtml

 

[Cachilupi]

That is amazing, it worked perfect. Thank you so much for your help, it saved me a ton of time!

 

[erik.van.geit]

you're welcome

are you talking about the second code ?
I think it's way faster then the first I posted

 

[tmcfadden]

Set rngDelete = Worksheets("sheet1").Range("a1:I4788")

The way I wrote the code, you would use this instead:

Set rngDelete = Worksheets("sheet1").Range("a1:a4788")

This would move everything to column A.

But I guess Erik's worked for you.

-Tim

 

[Cachilupi]

That works too Tim. Thanks to the both of you, I can't believe people can respond so quickly, I spent 2+ hours and didn't get anywhere on my own!

 

[erik.van.geit]

That works too Tim. Thanks to the both of you, I can't believe people can respond so quickly, I spent 2+ hours and didn't get anywhere on my own!

there are a few basic codes and a few basic instincts involved
check out the link I posted and a new world could become yours