Shifting blank cell to left in XL 2003

Cachilupi

New Member
Joined
Oct 13, 2006
Messages
24
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!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

tmcfadden

Board Regular
Joined
Aug 17, 2005
Messages
151
Try this routine:
Code:
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:
Code:
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

New Member
Joined
Oct 13, 2006
Messages
24
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
Code:
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
Code:
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

nevermind
this is satisfying
Code:
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

New Member
Joined
Oct 13, 2006
Messages
24
That is amazing, it worked perfect. Thank you so much for your help, it saved me a ton of time!
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

you're welcome :)

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

tmcfadden

Board Regular
Joined
Aug 17, 2005
Messages
151
Set rngDelete = Worksheets("sheet1").Range("a1:I4788")

The way I wrote the code, you would use this instead:
Code:
Set rngDelete = Worksheets("sheet1").Range("a1:a4788")

This would move everything to column A.

But I guess Erik's worked for you.

-Tim
 

Cachilupi

New Member
Joined
Oct 13, 2006
Messages
24
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
 

Forum statistics

Threads
1,136,595
Messages
5,676,707
Members
419,644
Latest member
KeelsM

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top