Search code examples
excelvbadelete-row

Excel VBA - If cell is an integer, delete the entire row


I have been trying to use some snippets on how to delete entire rows on Excel VBA, but I can't modify them to include the "IsNumber" verification.

I need to be able to choose an active area, like:

Set r = ActiveSheet.Range("A1:C10")

And as it goes through row after row (and checking every cell of the area), delete the entire row if a there is a number on a cell.

For example:

NA NA NA 21
NA 22 NA 44
00 NA NA NA
NA NA NA NA
55 NA NA NA

The macro would then delete all the rows, except for the 4th one which is

NA NA NA NA

Solution

  • Take your pick :)

    WAY 1 (TRIED AND TESTED)

    This uses SpecialCells to identify the rows which has numbers.

    Sub Sample()
        Dim ws As Worksheet
        Dim rng As Range
    
        On Error GoTo Whoa
    
        Set ws = Sheets("Sheet1")
    
        With ws
            Set rng = .Cells.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow
    
            rng.ClearContents '<~~ or rng.Clear if cells have formatting
    
            .Cells.Sort Key1:=.Range("A1")
        End With
    
        Exit Sub
    Whoa:
        MsgBox Err.Description
    End Sub
    

    WAY 2 (TRIED AND TESTED)

    This uses Looping and Count() to check for numbers

    Sub Sample()
        Dim ws As Worksheet
        Dim delrange As Range
        Dim lRow As Long, i As Long
    
        On Error GoTo Whoa
    
        Set ws = Sheets("Sheet1")
    
        With ws
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
            For i = 1 To lRow
                If Application.WorksheetFunction.Count(.Rows(i)) > 0 Then
                    If delrange Is Nothing Then
                        Set delrange = .Rows(i)
                    Else
                        Set delrange = Union(delrange, .Rows(i))
                    End If
                End If
            Next i
    
            If Not delrange Is Nothing Then delrange.Delete
        End With
    
        Exit Sub
    Whoa:
        MsgBox Err.Description
    End Sub
    

    Way 3 (TRIED AND TESTED)

    This uses Auto Filters. I am assuming that row 1 has headers and there is no blank cell in your range.

    Sub Sample()
        Dim ws As Worksheet
        Dim lRow As Long, lCol As Long, i As Long
        Dim ColN As String
    
        On Error GoTo Whoa
    
        Set ws = Sheets("Sheet1")
    
        With ws
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
            For i = 1 To lCol
                '~~> Remove any filters
                .AutoFilterMode = False
                ColN = Split(.Cells(, i).Address, "$")(1)
    
                '~~> Filter, offset(to exclude headers) and delete visible rows
                With .Range(ColN & "1:" & ColN & lRow)
    
                    .AutoFilter Field:=1, Criteria1:=">=" & _
                    Application.WorksheetFunction.Min(ws.Columns(i)), _
                    Operator:=xlOr, Criteria2:="<=" & _
                    Application.WorksheetFunction.Max(ws.Columns(i))
    
                    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End With
    
                '~~> Remove any filters
                .AutoFilterMode = False
            Next
        End With
    
        Exit Sub
    Whoa:
        MsgBox Err.Description
    End Sub