CODEWITHSUNDEEP
excelvba
Bluesector
Bluesector

Reputation: 329

Excel VBA - find and delete blank cells in a row-range

I want to make a macro that finds every blank cell in column D. For example: If D4 has a blank cell, the cells B4, C4, D4, E4 should be deleted and shifted up so that there are now more blank cells.

Somehow the macro doesn't delete anything.

Dim delREASON As Variant
Dim findReason As Range
Dim DelRng As Range

    With ThisWorkbook.Sheets("getDATA")
        delREASON = Null
        For Each findReason In .Range(.Range("D8"), .Range("D8").End(xlDown))
            If Not (IsError(Application.Match(findReason.Value, delREASON, 0))) Then
                If Not DelRng Is Nothing Then
            Set DelRng = Application.Union(DelRng, .Range(.Cells(findReason.Row, "B"), .Cells(findReason.Row, "E")))
        Else
            Set DelRng = .Range(.Cells(findReason.Row, "B"), .Cells(findReason.Row, "E"))
        End If
    End If
Next
    End With

Upvotes: 1

Views: 163

Answers (1)

user4039065
user4039065

Reputation:

Locate the blank cells in column D and then create a union of the other adjoining columns.

Dim blnks As Range
With ThisWorkbook.Sheets("getDATA")
    On Error Resume Next
    Set blnks = .Columns("D").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not blnks Is Nothing Then
        Set blnks = Union(blnks.Offset(0, -2), blnks.Offset(0, -1), _
                          blnks, blnks.Offset(0, 1))
        blnks.Delete shift:=xlUp
    End If
End With

Upvotes: 1

Related Questions