How to delete empty cells from Range & hellip;

advertisements

Let's say I a have range $A$1:$A$10 like this. (This will vary every time)

   |  A          B
-------------------
 1 |  a          1
 2 |  b          2
 3 |
 4 |  c
 5 |
 6 |             Delete this
 7 |  d          4
 8 |
 9 |  e
10 |  f          5

Now, I want to remove empty cells in a way so that it will look like this.
I need to delete "Delete this" cell all the time.

   |  A          B
-------------------
 1 |  a          1
 2 |  b          2
 4 |  c
 5 |  d          4
 6 |  e
 7 |  f          5

So far, I've used this but I'm not getting what I want.

Sub test()
    Dim lastrow As Long
    Dim cell As Range
    Dim rng As Range

    'change sheet name to suit
    With ThisWorkbook.Worksheets("ws")
        'find lastrow in columns A:B
        lastrow = Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, _
                                    .Cells(.Rows.Count, "B").End(xlUp).Row)

        'Iterates throught each cell in D:E and if it equals to ""
        For Each cell In .Range("A:B" & lastrow)
            If (cell.Value = "") Or (cell.Value = "Delete this") Then
                If rng Is Nothing Then
                    Set rng = cell
                Else
                    Set rng = Union(rng, cell)
                End If
            End If
        Next

        'delete all empty cells (with "")
        If Not rng Is Nothing Then rng.Delete Shift:=xlUp

    End With
End Sub

Is there any easy way to do this...?


I can't tell the exact criteria you're using to delete a row, but it appears it's only when both columns are empty OR if column A is empty and column B has "delete this" in it. Assuming that's the case, I'd use the following Do-Loop

Sub test()
    Dim lastrow As Long

    'change sheet name to suit
    With ThisWorkbook.Worksheets("ws")
        'find lastrow in columns A:B
        lastrow = Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, _
                                    .Cells(.Rows.Count, "B").End(xlUp).Row)

        'Iterates throught each cell in D:E and if it equals to ""
        ActiveSheet.Range("A1").Select
        Do
            If (ActiveCell.Value = "" And (ActiveCell.Offset(0, 1).Value = "" Or ActiveCell.Offset(0, 1).Value = "Delete This")) Then
                ActiveCell.EntireRow.Delete
                ActiveCell.Offset(-1, 0).Select
                lastrow = lastrow - 1
            End If
            ActiveCell.Offset(1, 0).Select
        Loop Until (ActiveCell.Row = lastrow)
    End With
End Sub