VBA Deleting specific ranges when empty and shift up

Question

I checked the search function, but could not find any answer to my issue.

What I want is VBA to check a specific range for 200+ rows whether these are entirely empty and if so, to delete these and shift up cells.

Sub delete_empty_cells2() 
    Dim k As Integer 
    Dim r As Range
    For k = 4 To 260 
        Set r = Range("AAk:AFk") 
        If r.Value = "" Then
            r.Select 
            Selection.SpecialCells(xlCellTypeBlanks).Select
            Selection.Delete Shift:=xlUp 
        End If 
    Next k
End Sub

Now obviously, the code is wrong. I'm not really used to VBA yet and don't know all commands / objects. Is there a way to tell VBA that the range is variable (it should check all ranges, e.g. starting by checking AA4:AF4).

Thanks in advance!

Zahbi

So you want to delete blank cells (shifting up) and completely disregard their relationship to adjoining non-blank cells? — , Jun 14 '17 at 16:50
Zahbi, if you feel that your question is not a duplicate then feel free to leave a message here explaining why it is not and I or someone else will re-open the question — Siddharth Rout, Jun 14 '17 at 17:39

score 1 · Answer 1 · answered Jun 14 '17 at 16:57

You should go backwards in your loop and look at the code below to see how to use k variable accordingly. If you loop forwards, when you delete a row, you should decrease this number from your loop variable and it is a lot of work, plus confusing.

Try this:

Sub delete_empty_cells2()
    Dim k As Long
    Dim r As Range
    For k = 260 To 4 Step -1
        Set r = Range("AA" & k & ":AF" & k)
        If Application.WorksheetFunction.CountA(r) = 0 Then
            Rows(k).EntireRow.Delete
        End If
    Next k
End Sub

score 1 · Answer 2 · answered Jun 14 '17 at 17:02

Here's one way to do it. You don't actually have to delete anything until right at the end -- it's much quicker.

Sub delete_empty_cells2()
    Dim rng As Range, fullRow As Range, populatedRange As Range, emptyRange As Range

    Set rng = Sheet1.Range("AA4:AF260")

    For Each fullRow In rng.Rows
        Set populatedRange = fullRow.Find("*")
        If populatedRange Is Nothing Then
            If emptyRange Is Nothing Then
                Set emptyRange = fullRow
            Else
                Set emptyRange = Union(emptyRange, fullRow)
            End If
        End If
    Next fullRow

    If Not emptyRange Is Nothing Then emptyRange.Delete
End Sub

VBA Deleting specific ranges when empty and shift up

2 Answers2