delete blank cells, shift populated cells right

[BonnieM]

I have a very large spreadsheet with rows of data containing blank cells in the middle of a row.

I need to delete the blank cells within a range and shift the populated cells to the right.

I'm a vba beginner.

Tried this in "this workbook":

Sub Blanks()
Range("A1:x9").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlRight
End Sub

but got an error "X 400" which I can't even find in the help screens!

Can anybody be a hero here?

 

[lrobbo314]

Do you really want to shift the cells to the right? I don't think that is an option. Even if you do it manually in the spreadsheet, to the left or up is all that is available.

Here's some code that would delete the cells, shifting to the left.

Sub test()
Dim r As Range
Dim x As Integer

Set r = Range("A1:X9")

For x = r.Cells.Count To 1 Step -1
    If r.Cells(x) = "" Then
        r.Cells(x).Delete Shift:=xlToLeft
    End If
Next x

End Sub

 

[BonnieM]

I do need to shift to the right, so I can access the populated cells to do calcs with consistent formulas.

so far I have been sorting the file column by column on blanks, cutting each 'chunk' of blanks and inserting cut cells in front of the ones on the left. very time consuming.

 

[lrobbo314]

OK, how about this then.

Sub test()
Dim r As Range
Dim x As Integer

Set r = Range("A1:X9")

For x = r.Cells.Count To 1 Step -1
    If r.Cells(x) = "" Then
        Range(r(x).Offset(, -1), r(x).Offset(, -1).End(xlToLeft)).Cut Range(r(x).Offset(, -1), r(x).Offset(, -1).End(xlToLeft)).Offset(, 1)
    End If
Next x

End Sub

 

[BonnieM]

Ok I pasted this into This Workbook, and ran macro - nothing happened

As a said, I'm a beginner, do I need to do something else?

 

[lrobbo314]

Sorry,

I tested that code and found that it wouldn't work.

This should work.

Sub test()
On Error GoTo errH
Dim r As Range
Dim b As Range
Dim x As Integer

Set r = Range("A1:X9")

For x = r.Cells.Count To 1 Step -1
    If r(x).Address = "$S$1" Then
        Debug.Print
    End If
    If r(x).Column() <> 1 Then
        If r(x) = "" Then
            Debug.Print r(x).Address
            Set b = Range(r(x), r(x).End(xlToLeft).Offset(, 1))
            b = b.Offset(, -b.Cells.Count).Value
            b.Offset(, -b.Cells.Count) = vbNullString
        End If
    End If
Next x

errH:
If x = 0 Then Exit Sub
Set b = r(x).End(xlToLeft)
r(x) = b.Value
b.Value = vbNullString
Resume Next

End Sub

 

[BonnieM]

nothing happened

 

[lrobbo314]

So you are pasting the code in the VBA editor.

Then how are you running it?

Also, I used your range of A1:X9. Is that the range of cells that you want to perform this code on?

 

[lrobbo314]

Also, don't put it in the this workbook. That won't work.

Open the VBA editor.

Go to the toolbar and click insert>module.

Paste the code.

Then run it.

 

[BonnieM]

It's a huge spreadsheet, over 50,000 lines and 30 columns - I just put that range in as a test

The blanks occur in columns c through x, and number of blanks varies per row.

So actual range would be c2 (because there are headers) through say, x53000

I need to knock the populated cells up against column Y in order to standardize the calcs.

I pasted into This Workbook, then hit Run from the Macro button.

I can't seem to paste a screen shot here.

Does this help?