Results 1 to 4 of 4
  1. #1
    Join Date
    Jan 2012

    Unanswered: Delete row if all cells in range are blank

    I've scoured the internet for solutions but cannot find it for this.

    I'd like to delete rows if "all" of the cells between columns F and H in the row are empty. The range to examine is F45:H3000. (I'd also like the rows that stay to be moved up.)

    For example, in the below data the macro would delete rows 46 & 49, because those rows have nothing in columns F, G, and H:

        A  ... F      G       H 
    45  2  ... Red        
    46  2  ... 
    47  2  ... Hello          Blue
    48  2  ...        Green
    49  2  ...
    I thought the code below would do it but it doesn't find any rows that meet the criteria. (If I comment out the On Error line, I get "No cells were found.") Any suggestions?

    Sub RemoveBlankRows()
        Dim rgCol As Range
        On Error Resume Next
        For Each rgCol In Range("F45:H3000").Columns
        Next rgCol
    End Sub

  2. #2
    Join Date
    Apr 2004
    Derbyshire, UK
    Provided Answers: 2

    This may seem like a sledge hammer to crack a nut, but it's the way I see things!
    Sub RemoveBlankRows(ByVal Rng As Range)
        Dim iRow As Integer
        Dim iCol As Integer
        Dim bIsBlank As Boolean
        For iRow = Rng.Row + Rng.Rows.Count - 1 To Rng.Row Step -1
            bIsBlank = True
            For iCol = Rng.Column To Rng.Column + Rng.Rows.Columns.Count - 1
                If Cells(iRow, iCol) <> "" Then bIsBlank = False
            Next iCol
            If bIsBlank Then Rows(iRow).EntireRow.Delete
        Next iRow
    End Sub
    Sub Test()
        RemoveBlankRows Range("F44:H53")
    End Sub
    Note you have to delete row starting at the bottom!



  3. #3
    Join Date
    Jan 2012
    It is indeed a mighty hammer but it works, so thank you!

  4. #4
    Join Date
    Sep 2008
    London, UK
    Here's how you would do it using your original idea of the Range.SpecialCells() method:

    Sub test()
        Dim rngToCheck As Range
        Dim rngToDelete As Range
        Dim rngCol As Range
        Set rngToCheck = Range("F45:H3000")
        Set rngToDelete = rngToCheck.Columns(1)
        For Each rngCol In rngToCheck.Columns
            On Error Resume Next
            Set rngToDelete = Intersect(rngToDelete.EntireRow, rngCol.SpecialCells(xlCellTypeBlanks))
            On Error GoTo 0
            If rngToDelete Is Nothing Then Exit For
        Next rngCol
        If Not rngToDelete Is Nothing Then
            Application.ScreenUpdating = False
            Application.ScreenUpdating = True
        End If
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts