Delete row if cell in changing column is blank

Question

This is is Excel 2010 on Windows 7.

I receive spreadsheets where one of the columns is called "Approved." This column is filled with x's and blanks. I want to delete all rows that have blanks in that column. This is a simple problem but has two confounding issues:

The location of the Approved column changes, so I can't just do Columns("R").SpecialCells(xlBlanks).EntireRow.Delete. I try to get around this by searching for "Approve" in A1:Z5 (since there are always fewer than 26 rows), and selecting the column in which it is found.
Much of the data is pulled from a previous month's document so some of the "blank" cells are populated with a vlookup. I try to get around this by first selecting all data and pasting as values.

Here is the current code:

Sub DeleteCol()
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

  Dim rngApprove As Range
  Set rngApprove = Range("A1:Z5").Find("Approve")
  If rngApprove Is Nothing Then
    MsgBox "Approved column was not found."
    Exit Sub
  End If
  Dim approved_column As Range
  Set approved_column = rngApprove.EntireColumn
  approved_column.SpecialCells(xlBlanks).EntireRow.Delete
End Sub

The copy + paste as value works as intended. However, the row deletion only deletes rows 1-4 and leaves everything below row 5 alone, even though some of those cells are blank. If I replace the last line with

approved_column.select

it selects the whole column, as it should. This leads me to believe that the issue is with my deletion method.

Not sure the urgency or your willingness to give up but ... You could always make a loop that goes through each row deleting one at a time. I never used that command you are, if you run it multiple times does it do anything? Maybe it has some weird limit of 4 entire rows or something... — Holmes IV
I suspect this has something to do with when copying and pasting as value, even if the formula had a 0 length output it is still not considered EMPTY by excel. You might have to add a loop that cycles through your "Approved" column range and if the output is = "" (different then being empty) you can append it to a range. Once your loop is done you can have VBA delete all the rows for that range in one fell swoop. Cheers — nbayly
Shouldn't you be be searching for "Approve" in A1:Z1? What is the point of looking through the other 4 rows? — user4039065

paul bica paul bica · Accepted Answer · 2015-08-19T22:12:23

Try this (based on delete rows optimization solution)

Option Explicit

Sub deleteRowsWithBlanks()
    Const KEY_STRING As String = "Approve"
    Dim oldWs As Worksheet, newWs As Worksheet, rowHeights() As Long
    Dim wsName As String, rng As Range, filterCol As Long

    Set oldWs = ActiveSheet
    wsName = oldWs.Name
    Set rng = oldWs.Range("A1:Z5")
    filterCol = getHeaderColumn(rng, KEY_STRING, True)

    If filterCol > 0 Then
        FastWB True
        If rng.Rows.Count > 1 Then
            Set newWs = Sheets.Add(After:=oldWs)
            With oldWs.UsedRange
                .AutoFilter Field:=filterCol, Criteria1:="<>"
                .Copy
            End With
            With newWs.Cells
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteAll
                .Cells(1, 1).Select
                .Cells(1, 1).Copy
            End With
            oldWs.Delete
            newWs.Name = wsName
        End If
        FastWB False
    End If
End Sub

Helper functions:

Public Function getHeaderColumn(ByVal rng As Range, ByVal headerName As String, _
                                Optional matchLtrCase As Boolean = True) As Long
    Dim found As Range, foundCol As Long

    If Not rng Is Nothing Then
        headerName = Trim(headerName)
        If Len(headerName) > 0 Then
            Set found = rng.Find(What:=headerName, MatchCase:=matchLtrCase, _
                                 LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not found Is Nothing Then foundCol = found.Column
        End If
    End If
    getHeaderColumn = foundCol
End Function

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ActiveWorkbook.Sheets
            EnableWS ws, opt
        Next
    Else
        EnableWS ws, opt
    End If
End Sub
Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Delete row if cell in changing column is blank

2 Answers