loop through rows removing empty cells

Question

Hi Folks,

I have a spreadsheet with a list of customers in column A.  Columns B - I'm looking for a way to accomplish the following...

Beginning with the first row column B, look across the row and delete any empty cells (shift left) prior to the first occurrence of data.  Every row in column A will be populated to the end of the list.  The data will begin a variable number of columns across for each row.  Basically I'm looking for a programmatic way to condense each row to remove all empty cells prior to the data.

Answer 1

Sub Test() Dim A As Range For Each A In Range("A1", Range("A" & Rows.Count).End(xlUp)) Do While A.Offset(, 1) = 0 A.Offset(, 1).Delete xlShiftToLeft Loop Next Range("A1").CurrentRegion.Replace 0, "" End Sub

Answer 2

Hi Chris, and thanks for chiming in... I may have been a little misleading on my ad-hoc diagram...

this...

a | 0 | 0 | 0 | 1 | 3

b | 0 | 1 | 0 | 2 | 0 | 0 | 4

c | 1 | 0 | 5

should be this...

a |   |   |   | 1 | 3

b |   | 1 |   | 2 |   |   | 4

c | 1 |   | 5

into this...

a | 1 | 3

b | 1 |   | 2 |   |   | 4

c | 1 |   | 5

I only want to remove blank cells between column A and the first occurrence of data.  Anything after that can be ignored.

Answer 3

Hello Tourless. Here is what I would do.

I'm assuming row 1 is your header row.

Select B2 to end of your data.

Press F5 function key for Go To.

Select Special, then Blanks, then click OK.

Now only blanks are selected your range.

Right-click one of the blank cells and click Delete.

Pick Shift cells left.

Answer 4

Thanks Hans, but this doesn't leave the empty cells after the first occurrence of data.  Essentially I'm trying to turn this...

a | 0 | 0 | 0 | 1 | 3

b | 0 | 1 | 0 | 2 | 0 | 0 | 4

c | 1 | 0 | 5

into this...

a | 1 | 3

b | 1 | 0 | 2 | 0 | 0 | 4

c | 1 | 0 | 5

Answer 5

Here is a macro. If you have many rows and columns, it might be slow.

Sub RemoveEmpty()

    Dim r As Long

    Dim m As Long

    Dim c As Long

    Dim n As Long

    Application.ScreenUpdating = False

    m = Cells(Rows.Count, 1).End(xlUp).Row

    For r = 1 To m

        n = Cells(r, Columns.Count).End(xlToLeft).Column

        For c = n To 2 Step -1

            If Cells(r, c).Value = "" Then

                Cells(r, c).Delete Shift:=xlShiftToLeft

            End If

        Next c

    Next r

    Application.ScreenUpdating = True

End Sub