Excel VBA delete entire row if cell in column D is empty

Question

Can anyone walk me through how to write a script to delete the entire row if a cell in column D = "" on sheet 3 in range D13:D40.

Also, how to prevent the user from accidentally running the script again once those cells in the range are already deleted and other cells are now on the D13:D40 range?

Answer 1

Solution: This is working for me:

Sub DeleteRowsWithEmptyColumnDCell()
    Dim rng As Range
    Dim i As Long
    Set rng = ThisWorkbook.ActiveSheet.Range("D13:D40")
    With rng
        ' Loop through all cells of the range
        ' Loop backwards, hence the "Step -1"
        For i = .Rows.Count To 1 Step -1
            If .Item(i) = "" Then
                ' Since cell is empty, delete the whole row
                .Item(i).EntireRow.Delete
            End If
        Next i
    End With
End Sub

Explanation: Run a for loop through all cells in your Range in column D and delete the entire row if the cell value is empty. Important: When looping through rows and deleting some of them based on their content, you need to loop backwards , not forward. If you go forward and you delete a row, all subsequent rows get a different row number (-1). And if you have two empty cells next to each other, only the row of the first one will be deleted because the second one is moved one row up but the loop will continue at the next line.

Answer 2

No need for loops:

Sub SO()

Static alreadyRan As Integer

restart:

If Not CBool(alreadyRan) Then
    With Sheets("Sheet3")
        With .Range("D13:D40")
            .AutoFilter 1, "="
            With .SpecialCells(xlCellTypeVisible)
                If .Areas.Count > 1 Then
                    .EntireRow.Delete
                    alreadyRan = alreadyRan + 1
                End If
            End With
        End With
        .AutoFilterMode = False
    End With
Else
    If MsgBox("procedure has already been run, do you wish to continue anyway?", vbYesNo) = vbYes Then
        alreadyRan = 0
        GoTo restart:
    End If
End If

End Sub

Use AutoFilter to find blank cells, and then use SpecialCells to remove the results. Uses a Static variable to keep track of when the procedure has been run.

Answer 3

Here's my take on it. See the comments in the code for what happens along the way.

Sub deleterow()
  ' First declare the variables you are going to use in the sub
  Dim i As Long, safety_net As Long
  ' Loop through the row-numbers you want to change.
  For i = 13 To 40 Step 1
    ' While the value in the cell we are currently examining = "", we delete the row we are on
    ' To avoid an infinite loop, we add a "safety-net", to ensure that we never loop more than 100 times
    While Worksheets("Sheet3").Range("D" & CStr(i)).Value = "" And safety_net < 100
      ' Delete the row of the current cell we are examining
      Worksheets("Sheet3").Range("D" & CStr(i)).EntireRow.Delete
      ' Increase the loop-counter
      safety_net = safety_net + 1
    Wend
    ' Reset the loop-counter
    safety_net = 0
  ' Move back to the top of the loop, incrementing i by the value specified in step. Default value is 1.
  Next i
End Sub

To prevent a user from running the code by accident, I'd probably just add Option Private Module at the top of the module, and password-protect the VBA-project , but then again it's not that easy to run it by accident in the first place.

Answer 4

I've recently had to write something similar to this. I'm not sure that the code below is terribly professional, as it involves storing a value in cell J1 (obviously this can be changed), but it will do the job you require. I hope this helps:

Sub ColD()

Dim irow As long
Dim strCol As String

Sheets("sheet2").Activate
If Cells(1, 10) = "" Then
    lrun = " Yesterday."
Else: lrun = Cells(1, 10)
End If

MsgBox "This script was last run: " & lrun & "  Are you sure you wish to     continue?", vbYesNo
If vbYes Then
    For irow = 40 To 13 step -1
        strCol = Cells(irow, 4).Value
        If strCol = "" Then
            Cells(irow, 4).EntireRow.Delete
        End If
    Next
    lrun = Now()
    Cells(1, 10) = lrun
Else: Exit Sub
End If
End Sub

Answer 5

This code executes via a button on the sheet that, once run, removes the button from the worksheet so it cannot be run again.

Sub DeleteBlanks()
    Dim rw As Integer, buttonID As String

    buttonID = Application.Caller

    For rw = 40 To 13 Step -1

        If Range("D" & rw) = "" Then
            Range("D" & rw).EntireRow.Delete
        End If

    Next rw

    ActiveSheet.Buttons(buttonID).Delete
End Sub

You'll need to add a button to your spreadsheet and assign the macro to it.

Answer 6

There is no need for loops or filters to find the blank cells in the specified Range. The Range.SpecialCells property can be used to find any blank cells in the Range coupled with the Range.EntireRow property to delete these. To preserve the run state, the code adds a Comment to the first cell in the range. This will preserve the run state even if the Workbook is closed (assuming that it has been saved).

Sub DeleteEmpty()
   Dim ws As Excel.Worksheet
   Set ws = ActiveSheet       ' change this as is appropriate
   Dim sourceRange As Excel.Range
   Set sourceRange = ws.Range("d13:d40")
   Dim cmnt As Excel.Comment
   Set cmnt = sourceRange.Cells(1, 1).Comment

   If Not cmnt Is Nothing Then
      If cmnt.Text = "Deleted" Then
         If MsgBox("Do you wish to continue with delete?", vbYesNo, "Already deleted!") = vbNo Then
            Exit Sub
         End If
      End If
   End If

   Dim deletedThese As Excel.Range
   On Error Resume Next
   ' the next line will throw an error if no blanks cells found
   ' hence the 'Resume Next'
   Set deletedThese = sourceRange.SpecialCells(xlCellTypeBlanks)
   On Error GoTo 0
   If Not deletedThese Is Nothing Then
      deletedThese.EntireRow.Delete
   End If

   ' for preserving run state
   If cmnt Is Nothing Then Set cmnt = sourceRange.Cells(1, 1).AddComment
   cmnt.Text "Deleted"
   cmnt.Visible = False
End Sub