Condense a range to exclude blank rows

[Bluzdude]

I have a large range of cells. Some of the rows within this range contain all blank cells. I need a macro that will identify the blank rows and move the next row that contains values up to the last row that contained values, thus, condensing or compressing the range to include only rows that contain values. Each row will have a column that, when blank, indicates that the rest of the cells on that row are also blank.

I don't want to delete entire rows from the worksheet because that would remove data in other locations on the rows.

I assume the macro would have to do something like stepping through each row in the range and then do a "select" and "move" for the rows below the last row containing values and continue to the bottom of the range.

Is this possible?

 

[Legacy 68668]

try

Sub test()
Dim rng As Ragne, i As Long
Set rng = Application.InputBox("Select range", type:=8)
If rng Is Nothing Then Exit Sub
With rng
    For i = .Rows.Count To 1 Step -1
        If Application.CountBlank(.Rows(i).Cells) = .Columns.Count Then _
            .Rows(i).Delete xlShiftUp
    Next
End With
End Sub

tried ?

 

[SydneyGeek]

With three threads intertwining here, you can miss stuff.

If you're worried about deleting entire rows, look at my third post -- turns "" into blanks -- then the second post the shows how to delete blanks in a certain column range. Put them together and you should have your answer.

Denis

 

[Bluzdude]

That being the case, you can clear all of the "" entries first by doing something like

Dim c as Range
For Each c In Range("A:J").SpecialCells(xlCellTypeConstants)
  If c.Value="" Then c.ClearContents
Next c
'... then do the deletion step here, using SpecialCells to select blanks

Denis

The "clear contents" code should work to get rid of the "" values. However, it appears that your "deletion step" will delete all blank cells.

Let me explain further.

Let's say that range A1:A9 contain values, cells A6 and A7 are blank cells, the other cells in column A contain numbers or text.

In range B1:B9, cells B3, B6, and B7 are blank cells, the other cells in column B contain numbers or text.

If any cell in column A is blank then the adjacent cell in column B will also be blank and both those cells should be deleted.

Columns C and D must not be affected at all. What I want to do is delete the blank cells A6 and A7 and B6 and B7, while not affecting cells A3,B3,C3,D3,C6,D6,C7, or D7.

Below, in my crude representation of a spreadsheet, "ABCD" represent columns. The numbers in those columns occupy rows 1 through 9. The * represents blank cells.


ABCD
1111
2222
3*3*
4444
5555
**6*
***7
8888
9999

After deleting the rows, in range A1 thru B9, where the value in column A is blank, I should end up with this:

ABCD
1111
2222
3*3*
4444
5555
886*
99*7
**88
**99

In other words only range A1:B9 is compressed and only if there are blank cells in column A, columns C and D are not affected, because they are out of the range A1:B9.

Hope this helps, it would be much easier to be able to post a screenshot from Excel showing the before deletion and after deletion.

 

[Legacy 68668]

Sub test()
Dim i As Long
With Range("a1").CurrnetRegion.Resize(,2)
    For i = .Rows.Count To 1 Step -1
        If Application.CountBlank(.Rows(i).Cells) = 2 Then _
            .Rows(i).Delete xlShiftUp
    Next
End With
End Sub

 

[SydneyGeek]

If you check out my second post, you will see that I restrict the range to certain columns. that will do the job for you, leaving all other columns untouched. I used A:J as an example; change that to A:B if that is what you need.

The selection of blank cells actually only goes down to the end of the used range, so it's quite efficient. I prefer not to loop through cells when I delete -- it's much faster to do the deletion in one hit. See what I mean here...

Denis

 

[Bluzdude]

If you check out my second post, you will see that I restrict the range to certain columns. that will do the job for you, leaving all other columns untouched. I used A:J as an example; change that to A:B if that is what you need.

The selection of blank cells actually only goes down to the end of the used range, so it's quite efficient. I prefer not to loop through cells when I delete -- it's much faster to do the deletion in one hit. See what I mean here...

Denis

As I suspected, the code removes all blank cells from Range A:B, not just cells where both cell A and cell B are blank. If cell A isn't blank then no blank cells, in that row, should be deleted.

Column A is the key to this thing. If any row in column A is blank then both cell A and cell B, in that row, should be deleted.

This is the code in the macro:

Sub test()

Dim c As Range
    For Each c In Range("A:B").SpecialCells(xlCellTypeConstants)
        If c.Value = "" Then c.ClearContents
    Next c
    Range("A:B").SpecialCells(xlCellTypeBlanks).Delete

End Sub

 

[SydneyGeek]

OK, if that's the case, you could try:

Dim c As Range
    For Each c In Range("A:B").SpecialCells(xlCellTypeConstants)
        If c.Value = "" Then c.ClearContents
    Next c
    Range("A:A").SpecialCells(xlCellTypeBlanks).Select
    For Each c In Selection
        c.Resize(1,2).Delete Shift:=xlShiftUp
    Next c
End Sub

Denis

 

[Bluzdude]

OK, if that's the case, you could try:

Dim c As Range
    For Each c In Range("A:B").SpecialCells(xlCellTypeConstants)
        If c.Value = "" Then c.ClearContents
    Next c
    Range("A:A").SpecialCells(xlCellTypeBlanks).Select
    For Each c In Selection
        c.Resize(1,2).Delete Shift:=xlShiftUp
    Next c
End Sub

Denis

Ok, that deleted 1 row but there are still blanks in cells A6 and B6.

 

[Bluzdude]

I have to go to work now, I'll be back in a few hours.

 

[SydneyGeek]

Run this version. It loops up from the bottom of the table.

Sub NoBlanks_2()
    Dim c As Range
    Dim Rw As Long, RwLast As Long
    
    RwLast = Range("A65536").End(xlUp).Row
    
    For Each c In Range("A:B").SpecialCells(xlCellTypeConstants)
        If c.Value = "" Then c.ClearContents
    Next c
    For Rw = RwLast To 2 Step -1
        If IsEmpty(Cells(Rw, 1)) Then
            Cells(Rw, 1).Resize(1, 2).Delete shift:=xlShiftUp
        End If
    Next Rw
End Sub

Denis